Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:14 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002 
d0c66b198b Jean*0003       SUBROUTINE CAL_ADDTIME(
a63ed37559 Patr*0004      I                        date,
                0005      I                        interval,
                0006      O                        added,
d0c66b198b Jean*0007      I                        myThid )
                0008 
                0009 C     ==================================================================
                0010 C     SUBROUTINE cal_AddTime
                0011 C     ==================================================================
                0012 C
                0013 C     o Add a time interval either to a calendar date or to a time
                0014 C       interval.
                0015 C
                0016 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0017 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0018 C              - restructured the original version in order to have a
                0019 C                better interface to the MITgcmUV.
                0020 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0021 C              - Introduced new routine and function names, cal_<NAME>,
                0022 C                for verion 0.1.3.
                0023 C              ralf.giering@fastopt.de 31-May-2000
                0024 C                datesecs was computed at wrong place (cph)
                0025 C              menemenlis@jpl.nasa.gov 8-Oct-2003
                0026 C              speed-up computations for long integration interval
                0027 C
                0028 C     ==================================================================
                0029 C     SUBROUTINE cal_AddTime
                0030 C     ==================================================================
                0031 
                0032       IMPLICIT NONE
                0033 
                0034 C     == global variables ==
                0035 #include "EEPARAMS.h"
a63ed37559 Patr*0036 #include "cal.h"
                0037 
d0c66b198b Jean*0038 C     == routine arguments ==
                0039       INTEGER date(4)
                0040       INTEGER interval(4)
                0041       INTEGER added(4)
                0042       INTEGER myThid
                0043 
                0044 C     == external ==
                0045       INTEGER  cal_IsLeap
                0046       EXTERNAL cal_IsLeap
                0047 
                0048 C     == local variables ==
                0049       INTEGER intsecs
                0050       INTEGER datesecs
                0051       INTEGER nsecs
                0052       INTEGER hhmmss
                0053       INTEGER yi,mi,di,si,li,wi
                0054       INTEGER ndays, ndays_left, days_in_year
                0055       INTEGER date_1,date_2
                0056       INTEGER intv_1,intv_2
                0057       INTEGER fac
                0058       INTEGER iday
                0059       INTEGER switch
                0060       INTEGER ndayssub
                0061       INTEGER ierr
                0062       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0063 C     == end of interface ==
                0064 
                0065       IF ( cal_setStatus .LT. 1 ) THEN
                0066         WRITE( msgBuf,'(2A,4I9)')  'CAL_ADDTIME: ',
                0067      &       'date=',date(1),date(2),date(3),date(4)
                0068         CALL PRINT_ERROR( msgBuf, myThid )
                0069         WRITE( msgBuf,'(2A,4I9)')  'CAL_ADDTIME: ',
                0070      &   'interval=',interval(1),interval(2),interval(3),interval(4)
                0071         CALL PRINT_ERROR( msgBuf, myThid )
                0072         WRITE( msgBuf,'(2A,I2,A)') 'CAL_ADDTIME: ',
                0073      &    'called too early (cal_setStatus=',cal_setStatus,' )'
                0074         CALL PRINT_ERROR( msgBuf, myThid )
                0075         STOP 'ABNORMAL END: S/R CAL_ADDTIME'
                0076       ENDIF
a63ed37559 Patr*0077 
c84f6b7c89 Dimi*0078       if (interval(4) .ne. -1) then
                0079         ierr = 601
d0c66b198b Jean*0080         call cal_PrintError( ierr, myThid)
c84f6b7c89 Dimi*0081         stop ' stopped in cal_AddTime.'
                0082       endif
                0083 
a63ed37559 Patr*0084       date_1 = 0
                0085       date_2 = 0
c84f6b7c89 Dimi*0086       fac    = 1
a63ed37559 Patr*0087 
c84f6b7c89 Dimi*0088       if (date(4) .eq. -1) then
                0089          if (date(1) .ge. 0) then
a63ed37559 Patr*0090             date_1 = date(1)
                0091             date_2 = date(2)
                0092             intv_1 = interval(1)
                0093             intv_2 = interval(2)
c84f6b7c89 Dimi*0094          else
a63ed37559 Patr*0095             if (interval(1) .lt. 0) then
c84f6b7c89 Dimi*0096                date_1 = -date(1)
                0097                date_2 = -date(2)
                0098                intv_1 = -interval(1)
                0099                intv_2 = -interval(2)
                0100                fac    = -1
a63ed37559 Patr*0101             else
c84f6b7c89 Dimi*0102                date_1 = interval(1)
                0103                date_2 = interval(2)
                0104                intv_1 = date(1)
                0105                intv_2 = date(2)
                0106                fac    = 1
a63ed37559 Patr*0107             endif
c84f6b7c89 Dimi*0108          endif
                0109       else
                0110          if (interval(1) .ge. 0) then
a63ed37559 Patr*0111             intv_1 = interval(1)
                0112             intv_2 = interval(2)
c84f6b7c89 Dimi*0113          else
a63ed37559 Patr*0114             intv_1 = -interval(1)
                0115             intv_2 = -interval(2)
                0116             fac    = -1
c84f6b7c89 Dimi*0117          endif
                0118       endif
                0119 
d0c66b198b Jean*0120       intsecs  = fac*(intv_2/10000*secondsperhour +
c84f6b7c89 Dimi*0121      &     (mod(intv_2/100,100)*secondsperminute +
                0122      &     mod(intv_2,100)))
                0123 
                0124       if (date(4) .eq. -1) then
d0c66b198b Jean*0125          datesecs = date_2/10000*secondsperhour +
c84f6b7c89 Dimi*0126      &        mod(date_2/100,100)*secondsperminute +
                0127      &        mod(date_2,100)
                0128          date_1 = date_1 + intv_1
                0129          nsecs  = datesecs + intsecs
                0130          if ((date_1 .gt. 0) .and.
a63ed37559 Patr*0131      &        (nsecs  .lt. 0)) then
                0132             date_1 = date_1 - 1
                0133             nsecs  = nsecs + secondsperday
c84f6b7c89 Dimi*0134          endif
                0135          nsecs = fac*nsecs
                0136          yi     = 0
                0137          mi     = 0
                0138          di     = fac*date_1
                0139          li     = 0
                0140          wi     = -1
                0141       else
d0c66b198b Jean*0142          call cal_ConvDate( date,yi,mi,di,si,li,wi,myThid )
c84f6b7c89 Dimi*0143          if ((interval(1) .ge. 0) .and.
a63ed37559 Patr*0144      &        (interval(2) .ge. 0)) then
                0145             nsecs = si + intsecs
c84f6b7c89 Dimi*0146             ndays = interval(1)+nsecs/secondsperday
a63ed37559 Patr*0147             nsecs = mod(nsecs,secondsperday)
d0c66b198b Jean*0148 
                0149 C     This used to be called by exf_getffieldrec -> cal_GetDate
                0150 C     and was very slow for a long integration interval.
c84f6b7c89 Dimi*0151 c           do iday = 1,ndays
                0152 c             di = di + 1
                0153 c             if (di .gt. ndaymonth(mi,li)) then
                0154 c               di = 1
                0155 c               mi = mi + 1
                0156 c             endif
                0157 c             switch = (mi-1)/nmonthyear
                0158 c             yi = yi + switch
                0159 c             mi = mod(mi-1,nmonthyear)+1
d0c66b198b Jean*0160 c             if (switch .eq. 1) li = cal_IsLeap( yi, myThid )
c84f6b7c89 Dimi*0161 c           enddo
                0162 
d0c66b198b Jean*0163 C     Set start value
c84f6b7c89 Dimi*0164             ndays_left=ndays
e50a7d3fbe Patr*0165 
d0c66b198b Jean*0166 C     First take care of February 29
e50a7d3fbe Patr*0167             if ( usingGregorianCalendar ) then
                0168                if ( mi.eq.2 .and. di.eq.29 .and. ndays_left.gt.1 ) then
                0169                   mi = 3
                0170                   di = 1
                0171                   ndays_left = ndays_left - 1
                0172                endif
c84f6b7c89 Dimi*0173             endif
                0174 
d0c66b198b Jean*0175 C     Next compute year
e50a7d3fbe Patr*0176             days_in_year=ndaysnoleap
d0c66b198b Jean*0177             if ((mi.gt.2.and.cal_IsLeap(yi+1,myThid).eq.2).or.
                0178      &           (mi.le.2.and.cal_IsLeap(yi,myThid).eq.2) )
e50a7d3fbe Patr*0179      &           days_in_year=ndaysleap
c84f6b7c89 Dimi*0180             do while (ndays_left .ge. days_in_year)
                0181                ndays_left = ndays_left - days_in_year
                0182                yi = yi + 1
e50a7d3fbe Patr*0183                days_in_year=ndaysnoleap
d0c66b198b Jean*0184                if ((mi.gt.2.and.cal_IsLeap(yi+1,myThid).eq.2).or.
                0185      &              (mi.le.2.and.cal_IsLeap(yi,myThid).eq.2) )
e50a7d3fbe Patr*0186      &              days_in_year=ndaysleap
c84f6b7c89 Dimi*0187             enddo
d0c66b198b Jean*0188             li = cal_IsLeap( yi, myThid )
c84f6b7c89 Dimi*0189 
d0c66b198b Jean*0190 C     Finally compute day and month
c84f6b7c89 Dimi*0191             do iday = 1,ndays_left
                0192                di = di + 1
                0193                if (di .gt. ndaymonth(mi,li)) then
                0194                   di = 1
                0195                   mi = mi + 1
                0196                endif
                0197                switch = (mi-1)/nmonthyear
                0198                yi = yi + switch
                0199                mi = mod(mi-1,nmonthyear)+1
d0c66b198b Jean*0200                if (switch .eq. 1) li = cal_IsLeap( yi, myThid )
a63ed37559 Patr*0201             enddo
c84f6b7c89 Dimi*0202             wi = mod(wi+ndays-1,7)+1
                0203 
                0204          else
a63ed37559 Patr*0205             nsecs = si + intsecs
                0206             if (nsecs .ge. 0) then
c84f6b7c89 Dimi*0207                ndayssub = intv_1
a63ed37559 Patr*0208             else
c84f6b7c89 Dimi*0209                nsecs = nsecs + secondsperday
                0210                ndayssub = intv_1 + 1
a63ed37559 Patr*0211             endif
                0212             do iday = 1,ndayssub
c84f6b7c89 Dimi*0213                di = di - 1
                0214                if (di .eq. 0) then
                0215                   mi = mod(mi+10,nmonthyear)+1
                0216                   switch = mi/nmonthyear
                0217                   yi = yi - switch
d0c66b198b Jean*0218                   if (switch .eq. 1) li = cal_IsLeap( yi, myThid )
c84f6b7c89 Dimi*0219                   di = ndaymonth(mi,li)
                0220                endif
a63ed37559 Patr*0221             enddo
                0222             wi = mod(wi+6-mod(ndayssub,7),7)+1
c84f6b7c89 Dimi*0223          endif
a63ed37559 Patr*0224       endif
                0225 
d0c66b198b Jean*0226 C     Convert to calendar format.
c84f6b7c89 Dimi*0227       added(1) = yi*10000 + mi*100 + di
                0228       hhmmss   = nsecs/secondsperminute
                0229       added(2) = hhmmss/minutesperhour*10000 +
                0230      &     (mod(fac*hhmmss,minutesperhour)*100 +
                0231      &     mod(fac*nsecs,secondsperminute))*fac
                0232       added(3) = li
                0233       added(4) = wi
                0234 
d0c66b198b Jean*0235       RETURN
                0236       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!