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_TOSECONDS(
a63ed37559 Patr*0004 I date,
0005 O timeint,
d0c66b198b Jean*0006 I myThid )
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
0036 IMPLICIT NONE
0037
0038
0039 #include "EEPARAMS.h"
a63ed37559 Patr*0040 #include "cal.h"
0041
d0c66b198b Jean*0042
0043 INTEGER date(4)
a63ed37559 Patr*0044 _RL timeint
d0c66b198b Jean*0045 INTEGER myThid
a63ed37559 Patr*0046
d0c66b198b Jean*0047
434c2252b7 Dimi*0048 _RL fac, nsecs, ndays
d0c66b198b Jean*0049 INTEGER ierr, check_sign, hhmmss
0050 CHARACTER*(MAX_LEN_MBUF) msgBuf
0051
a63ed37559 Patr*0052
df219ab40a Curt*0053
0054
a63ed37559 Patr*0055
d0c66b198b Jean*0056 IF ( cal_setStatus .LT. 1 ) THEN
0057 WRITE( msgBuf,'(2A,4I9)') 'CAL_TOSECONDS: ',
0058 & 'date=',date(1),date(2),date(3),date(4)
0059 CALL PRINT_ERROR( msgBuf, myThid )
0060 WRITE( msgBuf,'(2A,I2,A)') 'CAL_TOSECONDS: ',
0061 & 'called too early (cal_setStatus=',cal_setStatus,' )'
0062 CALL PRINT_ERROR( msgBuf, myThid )
0063 STOP 'ABNORMAL END: S/R CAL_CONVDATE'
0064 ENDIF
0065
b52b3e8d0d Dimi*0066 check_sign = 1
0067 if ( ( (date(1).lt.0) .and. date(2).gt.0 ) .or.
0068 & ( (date(1).gt.0) .and. date(2).lt.0 ) )
0069 & check_sign = -1
0070
df219ab40a Curt*0071 if (((date(4) .eq. -1) .and.
a63ed37559 Patr*0072 & (date(3) .eq. 0) .and.
34fdea0d95 Dimi*0073 & (check_sign .ge. 0)) .or.
df219ab40a Curt*0074 & usingModelCalendar) then
a63ed37559 Patr*0075 if ((date(1) .lt. 0) .or.
0076 & (date(2) .lt. 0)) then
0077 ndays = -date(1)
0078 hhmmss = -date(2)
0079 fac = -1
0080 else
0081 ndays = date(1)
0082 hhmmss = date(2)
0083 fac = 1
0084 endif
0085 nsecs = ndays*secondsperday +
0086 & (hhmmss/10000)*secondsperhour +
0087 & mod(hhmmss/100,100)*secondsperminute +
0088 & mod(hhmmss,100)
0089 timeint = fac*nsecs
0090 else
0091
0092 ierr = 1001
d0c66b198b Jean*0093 call cal_PrintError( ierr, myThid )
a63ed37559 Patr*0094 stop ' stopped in cal_ToSeconds.'
0095
0096 endif
0097
d0c66b198b Jean*0098 RETURN
0099 END