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 INTEGER FUNCTION CAL_ISLEAP(
a63ed37559 Patr*0004 I year,
d0c66b198b Jean*0005 I myThid )
a63ed37559 Patr*0006
d0c66b198b Jean*0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
a63ed37559 Patr*0025
d0c66b198b Jean*0026 IMPLICIT NONE
a63ed37559 Patr*0027
d0c66b198b Jean*0028
0029 #include "EEPARAMS.h"
a63ed37559 Patr*0030 #include "cal.h"
0031
d0c66b198b Jean*0032
0033 INTEGER year
0034 INTEGER myThid
a63ed37559 Patr*0035
d0c66b198b Jean*0036
0037 CHARACTER*(MAX_LEN_MBUF) msgBuf
0038
a63ed37559 Patr*0039
d0c66b198b Jean*0040 IF ( cal_setStatus .LT. 1 ) THEN
0041 WRITE( msgBuf,'(A,2(A,I9))') 'CAL_ISLEAP: ',
0042 & 'year=', year
0043 CALL PRINT_ERROR( msgBuf, myThid )
0044 WRITE( msgBuf,'(2A,I2,A)') 'CAL_ISLEAP: ',
0045 & 'called too early (cal_setStatus=',cal_setStatus,' )'
0046 CALL PRINT_ERROR( msgBuf, myThid )
0047 STOP 'ABNORMAL END: FUNCTION CAL_ISLEAP'
0048 ENDIF
a63ed37559 Patr*0049
0050 if ( usingGregorianCalendar ) then
0051 if ( mod(year,4) .ne. 0 ) then
0052 cal_IsLeap = 1
0053 else
0054 cal_IsLeap = 2
0055 if ( (mod(year,100) .eq. 0) .and.
0056 & (mod(year,400) .ne. 0) ) then
0057 cal_IsLeap = 1
0058 endif
0059 endif
0060 else if ( usingJulianCalendar ) then
0061 if ( mod(year,4) .ne. 0 ) then
0062 cal_IsLeap = 1
0063 else
0064 cal_IsLeap = 2
0065 endif
0066 else
0067 cal_IsLeap = 1
0068 endif
0069
d0c66b198b Jean*0070 RETURN
0071 END