File indexing completed on 2018-03-02 18:38:15 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_FULLDATE(
a63ed37559 Patr*0004 I yymmdd,
0005 I hhmmss,
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 IMPLICIT NONE
0029
0030
0031 #include "EEPARAMS.h"
a63ed37559 Patr*0032 #include "cal.h"
0033
d0c66b198b Jean*0034
0035
0036 INTEGER yymmdd
0037 INTEGER hhmmss
0038 INTEGER date(4)
0039 INTEGER myThid
0040
0041
0042 INTEGER cal_IsLeap
0043 EXTERNAL cal_IsLeap
0044
0045
0046 INTEGER theyear
12fd5e6104 Jean*0047 INTEGER numberOfDays(4)
d0c66b198b Jean*0048 INTEGER calerr
0049 LOGICAL valid
0050 CHARACTER*(MAX_LEN_MBUF) msgBuf
0051
a63ed37559 Patr*0052
0053 date(1) = yymmdd
0054 date(2) = hhmmss
0055 date(3) = 1
0056 date(4) = 1
0057
d0c66b198b Jean*0058 IF ( cal_setStatus .LT. 1 ) THEN
0059 WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
0060 & 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
0061 CALL PRINT_ERROR( msgBuf, myThid )
0062 WRITE( msgBuf,'(2A,I2,A)') 'CAL_FULLDATE: ',
0063 & 'called too early (cal_setStatus=',cal_setStatus,' )'
0064 CALL PRINT_ERROR( msgBuf, myThid )
0065 STOP 'ABNORMAL END: S/R CAL_FULLDATE'
0066 ENDIF
0067
0068
12fd5e6104 Jean*0069 CALL CAL_CHECKDATE( date, valid, calerr, myThid )
0070 IF ( calerr.NE.0 ) THEN
0071 WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
0072 & 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
0073 CALL PRINT_ERROR( msgBuf, myThid )
0074 CALL CAL_PRINTERROR( calerr, myThid )
0075 ENDIF
a63ed37559 Patr*0076
12fd5e6104 Jean*0077 IF (valid) THEN
d0c66b198b Jean*0078
a63ed37559 Patr*0079 theyear = yymmdd/10000
d0c66b198b Jean*0080 date(3) = cal_IsLeap( theyear, myThid )
a63ed37559 Patr*0081
d0c66b198b Jean*0082
12fd5e6104 Jean*0083 CALL CAL_TIMEPASSED( refDate, date, numberOfDays, myThid )
0084 IF ( numberOfDays(1).LT.0 ) THEN
0085
0086
0087 WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
0088 & 'refDate=', refDate(1), refDate(2), refDate(3), refDate(4)
0089 WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
0090 & ' date=', date(1), date(2), date(3), date(4)
0091 WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
0092 & 'numDays=', numberOfDays(1), numberOfDays(2),
0093 & numberOfDays(3), numberOfDays(4)
0094 ELSE
0095 date(4) = MOD(numberOfDays(1),7)+1
0096 ENDIF
0097 ELSE
0098 WRITE( msgBuf,'(2A)') 'CAL_FULLDATE: ',
0099 & 'fatal error from cal_CheckDate'
0100 CALL PRINT_ERROR( msgBuf, myThid )
0101 STOP 'ABNORMAL END: S/R CAL_FULLDATE'
0102 ENDIF
a63ed37559 Patr*0103
d0c66b198b Jean*0104 RETURN
0105 END