File indexing completed on 2018-03-02 18:38:14 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
af7f17a6b1 Jean*0003 SUBROUTINE CAL_CHECKDATE(
a63ed37559 Patr*0004 I date,
0005 O valid,
0006 O calerr,
af7f17a6b1 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 IMPLICIT NONE
0030
0031
0032 #include "EEPARAMS.h"
a63ed37559 Patr*0033 #include "cal.h"
0034
af7f17a6b1 Jean*0035
0036 INTEGER date(4)
0037 LOGICAL valid
0038 INTEGER calerr
0039 INTEGER myThid
0040
0041
0042
12fd5e6104 Jean*0043 INTEGER yy, mm, dd
af7f17a6b1 Jean*0044 INTEGER nsecs
0045 INTEGER lp,wd
12fd5e6104 Jean*0046 INTEGER hh, mn, ss
af7f17a6b1 Jean*0047 INTEGER hhmmss
12fd5e6104 Jean*0048 LOGICAL wrong_sign
af7f17a6b1 Jean*0049 CHARACTER*(MAX_LEN_MBUF) msgBuf
0050
a63ed37559 Patr*0051
0052 valid = .true.
0053 calerr = 0
12fd5e6104 Jean*0054
0055
0056 wrong_sign = ( (date(1).LT.0) .AND. date(2).GT.0 )
0057 & .OR. ( (date(1).GT.0) .AND. date(2).LT.0 )
a63ed37559 Patr*0058
12fd5e6104 Jean*0059 IF ( wrong_sign ) THEN
0060
0061 calerr = 1803
0062
0063 valid = .FALSE.
0064 ELSEIF ( cal_setStatus .LT. 1 ) THEN
0065 WRITE( msgBuf,'(2A,4I9)') 'CAL_CHECKDATE:',
0066 & ' date=',date(1),date(2),date(3),date(4)
0067 CALL PRINT_ERROR( msgBuf, myThid )
0068 WRITE( msgBuf,'(2A,I2,A)') 'CAL_CHECKDATE:',
0069 & ' called too early (cal_setStatus=',cal_setStatus,' )'
0070 CALL PRINT_ERROR( msgBuf, myThid )
0071
b52b3e8d0d Dimi*0072
12fd5e6104 Jean*0073 ELSEIF ( date(4).LE.0 ) THEN
0074
0075
0076 IF ( date(4).NE.-1 ) THEN
0077
a63ed37559 Patr*0078 calerr = 1801
12fd5e6104 Jean*0079 ELSEIF ( date(3).NE.0 ) THEN
0080
0081 calerr = 1802
0082 ENDIF
0083
0084 ELSE
0085
0086
0087 CALL CAL_CONVDATE( date, yy, mm, dd, nsecs, lp, wd, myThid )
0088 IF ( mm.EQ.0 .OR. ABS(mm).GT.nMonthYear ) THEN
0089 WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:',
0090 & ' Invalid month in date(1)=', date(1)
0091 CALL PRINT_ERROR( msgBuf, myThid )
0092
0093 valid = .FALSE.
0094 ELSEIF ( wd.LT.1 .OR. wd.GT.7 ) THEN
0095
a63ed37559 Patr*0096 calerr = 1805
12fd5e6104 Jean*0097
0098 ELSEIF ( lp.NE.1 .AND. lp.NE.2 ) then
0099
0100 calerr = 1806
0101
0102 valid = .FALSE.
0103 ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nMaxDayMonth ) THEN
0104
0105
0106 WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:',
0107 & ' Invalid day in date(1)=', date(1)
0108 CALL PRINT_ERROR( msgBuf, myThid )
0109 ELSEIF ( date(1).LT.refDate(1) ) THEN
0110
0111 calerr = 1807
0112 ENDIF
0113
0114 ENDIF
0115
0116 IF ( valid .AND. cal_setStatus.GE.1 ) THEN
0117
0118 hhmmss = ABS(date(2))
0119 hh = hhmmss/10000
0120 mn = MOD(hhmmss/100,100)
0121 ss = MOD(hhmmss,100)
0122 IF ( ss.GE.secondsPerMinute ) THEN
0123 WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
0124 & ' Invalid Seconds in date(2)=', date(2)
0125 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
0126 & SQUEEZE_RIGHT, myThid )
0127 ENDIF
0128 IF ( mn.GE.minutesPerHour ) THEN
0129 WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
0130 & ' Invalid Minutes in date(2)=', date(2)
0131 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
0132 & SQUEEZE_RIGHT, myThid )
0133 ENDIF
0134 IF ( hh.GE.hoursPerDay ) THEN
0135 WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
0136 & ' Invalid Hours in date(2)=', date(2)
0137 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
0138 & SQUEEZE_RIGHT, myThid )
0139 ENDIF
0140 ENDIF
a63ed37559 Patr*0141
af7f17a6b1 Jean*0142 RETURN
0143 END