pkg/cal/cal_timeinterval.F

6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
d0c66b198b Jean*0003       SUBROUTINE CAL_TIMEINTERVAL(
a63ed37559 Patr*0004      I                             timeint,
                0005      I                             timeunit,
                0006      O                             date,
d0c66b198b Jean*0007      I                             myThid )
                0008
                0009 C     ==================================================================
                0010 C     SUBROUTINE cal_TimeInterval
                0011 C     ==================================================================
                0012 C
                0013 C     o Create an array in date format given a time interval measured in
                0014 C       units of timeunit.
                0015 C       Available time units: 'secs'
                0016 C                             'model'
                0017 C       Fractions of seconds are not resolved in this version.
                0018 C
                0019 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0020 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0021 C              - restructured the original version in order to have a
                0022 C                better interface to the MITgcmUV.
                0023 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0024 C              - Introduced new routine and function names, cal_<NAME>,
                0025 C                for verion 0.1.3.
                0026 C
                0027 C     ==================================================================
                0028 C     SUBROUTINE cal_TimeInterval
                0029 C     ==================================================================
                0030
                0031       IMPLICIT NONE
                0032
                0033 C     == global variables ==
                0034 #include "EEPARAMS.h"
a63ed37559 Patr*0035 #include "cal.h"
                0036
d0c66b198b Jean*0037 C     == routine arguments ==
                0038       INTEGER date(4)
a63ed37559 Patr*0039       _RL     timeint
d0c66b198b Jean*0040       CHARACTER*(*) timeunit
                0041       INTEGER myThid
                0042
                0043 C     == local variables ==
                0044       INTEGER fac
                0045       INTEGER nsecs
                0046       INTEGER hhmmss
                0047       INTEGER ierr
c84f6b7c89 Dimi*0048       _RL     tmp1, tmp2
d0c66b198b Jean*0049       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0050 C     == end of interface ==
a63ed37559 Patr*0051
                0052       fac = 1
                0053       if (timeint .lt. 0) fac = -1
                0054
                0055       date(4) = -1
                0056       date(3) =  0
                0057       if (timeunit .eq. 'secs') then
                0058
d0c66b198b Jean*0059         IF ( cal_setStatus .LT. 1 ) THEN
149c9c5f82 Patr*0060           WRITE( msgBuf,'(2A,F19.2,2A)')  'CAL_TIMEINTERVAL: ',
d0c66b198b Jean*0061      &          'timeint=',timeint,' , timeunit=',timeunit
                0062           CALL PRINT_ERROR( msgBuf, myThid )
                0063           WRITE( msgBuf,'(2A,I2,A)') 'CAL_TIMEINTERVAL: ',
                0064      &      'called too early (cal_setStatus=',cal_setStatus,' )'
                0065           CALL PRINT_ERROR( msgBuf, myThid )
                0066           STOP 'ABNORMAL END: S/R CAL_TIMEINTERVAL'
                0067         ENDIF
a63ed37559 Patr*0068         date(1) = int(timeint/float(secondsperday))
c84f6b7c89 Dimi*0069         tmp1    = date(1)
                0070         tmp2    = secondsperday
                0071         nsecs   = int(timeint - tmp1 * tmp2 )
a63ed37559 Patr*0072
                0073       else if (timeunit .eq. 'model') then
                0074
d0c66b198b Jean*0075         IF ( cal_setStatus .LT. 2 ) THEN
f307db091b Patr*0076           WRITE( msgBuf,'(2A,F15.2,2A)')  'CAL_TIMEINTERVAL: ',
d0c66b198b Jean*0077      &          'timeint=',timeint,' , timeunit=',timeunit
                0078           CALL PRINT_ERROR( msgBuf, myThid )
                0079           WRITE( msgBuf,'(2A,I2,A)') 'CAL_TIMEINTERVAL: ',
                0080      &      'called too early (cal_setStatus=',cal_setStatus,' )'
                0081           CALL PRINT_ERROR( msgBuf, myThid )
                0082           STOP 'ABNORMAL END: S/R CAL_TIMEINTERVAL'
                0083         ENDIF
a63ed37559 Patr*0084         date(1) = int(timeint*modelstep/float(secondsperday))
                0085         nsecs   = int(timeint*modelstep -
6a5bb43215 Dimi*0086      &                float(date(1)) * float(secondsperday))
a63ed37559 Patr*0087
                0088       else
                0089
                0090         ierr = 701
d0c66b198b Jean*0091         call cal_PrintError( ierr, myThid )
a63ed37559 Patr*0092         stop ' stopped in cal_TimeInterval.'
                0093
                0094       endif
                0095
                0096       hhmmss  = nsecs/secondsperminute
                0097       date(2) = hhmmss/minutesperhour*10000 +
                0098      &          (mod(fac*hhmmss,minutesperhour)*100 +
                0099      &           mod(fac*nsecs,secondsperminute))*fac
                0100
d0c66b198b Jean*0101       RETURN
                0102       END