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_TIMEINTERVAL(
a63ed37559 Patr*0004 I timeint,
0005 I timeunit,
0006 O date,
d0c66b198b Jean*0007 I myThid )
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031 IMPLICIT NONE
0032
0033
0034 #include "EEPARAMS.h"
a63ed37559 Patr*0035 #include "cal.h"
0036
d0c66b198b Jean*0037
0038 INTEGER date(4)
a63ed37559 Patr*0039 _RL timeint
d0c66b198b Jean*0040 CHARACTER*(*) timeunit
0041 INTEGER myThid
0042
0043
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
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