Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:38:17 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_TIMEPASSED(
a63ed37559 Patr*0004      I                           initialdate,
                0005      I                           finaldate,
                0006      O                           numdays,
d0c66b198b Jean*0007      I                           myThid )
                0008 
                0009 C     ==================================================================
                0010 C     SUBROUTINE cal_TimePassed
                0011 C     ==================================================================
                0012 C
                0013 C     o Calculate the time that passed between initialdate and
                0014 C       finaldate.
                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
                0024 C     ==================================================================
                0025 C     SUBROUTINE cal_TimePassed
                0026 C     ==================================================================
                0027 
                0028       IMPLICIT NONE
                0029 
                0030 C     == global variables ==
                0031 #include "EEPARAMS.h"
a63ed37559 Patr*0032 #include "cal.h"
                0033 
d0c66b198b Jean*0034 C     == routine arguments ==
                0035       INTEGER initialdate(4)
                0036       INTEGER finaldate(4)
                0037       INTEGER numdays(4)
                0038       INTEGER myThid
                0039 
                0040 C     == external ==
                0041       INTEGER  cal_IsLeap
                0042       EXTERNAL cal_IsLeap
                0043 
                0044 C     == local variables ==
                0045       INTEGER yi,yf
                0046       INTEGER mi,mf
                0047       INTEGER di,df
                0048       INTEGER si,sf
                0049       INTEGER li,lf
                0050       INTEGER wi,wf
                0051       INTEGER cdi,cdf
                0052       INTEGER csi,csf
                0053       INTEGER ndays
                0054       INTEGER nsecs
                0055       INTEGER hhmmss
                0056       INTEGER imon
                0057       INTEGER iyr
                0058       INTEGER ierr
                0059       LOGICAL swap
                0060       LOGICAL caldates
                0061       LOGICAL nothingtodo
                0062       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0063 
                0064 C     == end of interface ==
                0065 
                0066       IF ( cal_setStatus .LT. 1 ) THEN
                0067         WRITE( msgBuf,'(2A,4I9)') 'CAL_TIMEPASSED: ', 'initialdate=',
                0068      &    initialdate(1),initialdate(2),initialdate(3),initialdate(4)
                0069         CALL PRINT_ERROR( msgBuf, myThid )
                0070         WRITE( msgBuf,'(2A,4I9)') 'CAL_TIMEPASSED: ', 'finaldate=',
                0071      &    finaldate(1),finaldate(2),finaldate(3),finaldate(4)
                0072         CALL PRINT_ERROR( msgBuf, myThid )
                0073         WRITE( msgBuf,'(2A,I2,A)') 'CAL_TIMEPASSED: ',
                0074      &    'called too early (cal_setStatus=',cal_setStatus,' )'
                0075         CALL PRINT_ERROR( msgBuf, myThid )
                0076         STOP 'ABNORMAL END: S/R CAL_TIMEPASSED'
                0077       ENDIF
a63ed37559 Patr*0078 
                0079       nothingtodo = .false.
                0080 
d0c66b198b Jean*0081 C     Initialise output.
a63ed37559 Patr*0082       numdays(1) =  0
                0083       numdays(2) =  0
                0084       numdays(3) =  0
                0085       numdays(4) = -1
                0086 
                0087       if ((initialdate(4) .gt. 0) .eqv.
                0088      &    (  finaldate(4) .gt. 0)) then
                0089 
                0090         caldates = (initialdate(4) .gt. 0) .and.
                0091      &             (  finaldate(4) .gt. 0)
                0092 
d0c66b198b Jean*0093 C       Check relation between initial and final dates.
a63ed37559 Patr*0094         if (initialdate(1) .eq. finaldate(1)) then
                0095           if (initialdate(2) .eq. finaldate(2)) then
                0096             nothingtodo = .true.
                0097           else if (initialdate(2) .gt. finaldate(2)) then
                0098             swap = .true.
                0099           else
                0100             swap = .false.
                0101           endif
                0102         else if (initialdate(1) .gt. finaldate(1)) then
                0103           swap = .true.
                0104         else
                0105           swap = .false.
                0106         endif
                0107 
                0108         if (.not. nothingtodo) then
                0109 
                0110           if (swap) then
d0c66b198b Jean*0111             call cal_ConvDate(   finaldate,yi,mi,di,si,li,wi,myThid )
                0112             call cal_ConvDate( initialdate,yf,mf,df,sf,lf,wf,myThid )
a63ed37559 Patr*0113           else
d0c66b198b Jean*0114             call cal_ConvDate( initialdate,yi,mi,di,si,li,wi,myThid )
                0115             call cal_ConvDate(   finaldate,yf,mf,df,sf,lf,wf,myThid )
a63ed37559 Patr*0116           endif
                0117 
d0c66b198b Jean*0118 C         Determine the time interval.
a63ed37559 Patr*0119           if (.not. caldates) then
                0120             ndays = df - di
                0121             nsecs = sf - si
                0122             if (nsecs .lt. 0) then
                0123               nsecs = nsecs + secondsperday
                0124               ndays = ndays - 1
                0125             endif
                0126             ndays = ndays + nsecs/secondsperday
                0127             nsecs = mod(nsecs,secondsperday)
                0128           else
                0129             si = si + (di-1)*secondsperday
                0130             sf = sf + (df-1)*secondsperday
                0131             cdi = 0
                0132             do imon = 1,mod(mi-1,12)
                0133               cdi = cdi + ndaymonth(imon,li)
                0134             enddo
                0135             csi = si
                0136             cdf = 0
                0137             do imon = 1,mod(mf-1,12)
                0138               cdf = cdf + ndaymonth(imon,lf)
                0139             enddo
                0140             csf = sf
                0141 
                0142             if (yi .eq. yf) then
                0143               ndays = (cdf + csf/secondsperday) -
                0144      &                (cdi + csi/secondsperday)
                0145               nsecs = (csf - (csf/secondsperday)*secondsperday) -
                0146      &                (csi - (csi/secondsperday)*secondsperday)
                0147               if (nsecs .lt. 0) then
                0148                 nsecs = nsecs + secondsperday
                0149                 ndays = ndays - 1
                0150               endif
                0151             else
d0c66b198b Jean*0152               ndays = (ndaysnoleap - 1) + cal_IsLeap( yi, myThid ) -
a63ed37559 Patr*0153      &                cdi - ndaymonth(mi,li)
                0154               do iyr = yi+1,yf-1
                0155                 ndays = ndays + (ndaysnoleap - 1) +
d0c66b198b Jean*0156      &                  cal_IsLeap( iyr, myThid )
a63ed37559 Patr*0157               enddo
                0158               ndays = ndays + cdf
                0159               csi   = ndaymonth(mi,li)*secondsperday - csi
                0160               nsecs = csi + csf
                0161             endif
                0162           endif
                0163 
d0c66b198b Jean*0164 C         Convert to calendar format.
a63ed37559 Patr*0165           numdays(1) = ndays + nsecs/secondsperday
                0166           nsecs      = mod(nsecs,secondsperday)
                0167           hhmmss     = nsecs/secondsperminute
                0168           numdays(2) = hhmmss/minutesperhour*10000 +
                0169      &                 mod(hhmmss,minutesperhour)*100 +
                0170      &                 mod(nsecs,secondsperminute)
                0171           if (swap) then
                0172             numdays(1) = -numdays(1)
                0173             numdays(2) = -numdays(2)
                0174           endif
                0175 
                0176         else
d0c66b198b Jean*0177 C         Dates are equal.
a63ed37559 Patr*0178         endif
                0179 
                0180       else
                0181 
                0182         ierr = 501
d0c66b198b Jean*0183         call cal_PrintError( ierr, myThid )
a63ed37559 Patr*0184         stop ' stopped in cal_TimePassed'
                0185 
                0186       endif
                0187 
d0c66b198b Jean*0188       RETURN
                0189       END