/[MITgcm]/MITgcm/pkg/cal/cal_isleap.F
ViewVC logotype

Contents of /MITgcm/pkg/cal/cal_isleap.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (show annotations) (download)
Sat Apr 7 16:21:05 2012 UTC (12 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.2: +43 -39 lines 
stop if called before pkg/cal parameters were set.
1 C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_isleap.F,v 1.2 2003/10/09 04:19:19 edhill Exp $
2 C $Name: $
3
4 #include "CAL_OPTIONS.h"
5
6 INTEGER FUNCTION CAL_ISLEAP(
7 I year,
8 I myThid )
9
10 C ==================================================================
11 C FUNCTION cal_IsLeap
12 C ==================================================================
13 C
14 C o In case the Gregorian calendar is used determine whether the
15 C given year is a leap year or not.
16 C
17 C started: Christian Eckert eckert@mit.edu 30-Jun-1999
18 C changed: Christian Eckert eckert@mit.edu 29-Dec-1999
19 C - restructured the original version in order to have a
20 C better interface to the MITgcmUV.
21 C Christian Eckert eckert@mit.edu 03-Feb-2000
22 C - Introduced new routine and function names, cal_<NAME>,
23 C for verion 0.1.3.
24 C
25 C ==================================================================
26 C FUNCTION cal_IsLeap
27 C ==================================================================
28
29 IMPLICIT NONE
30
31 C == global variables ==
32 #include "EEPARAMS.h"
33 #include "cal.h"
34
35 C == routine arguments ==
36 INTEGER year
37 INTEGER myThid
38
39 C == local variables ==
40 CHARACTER*(MAX_LEN_MBUF) msgBuf
41 C == end of interface ==
42
43 IF ( cal_setStatus .LT. 1 ) THEN
44 WRITE( msgBuf,'(A,2(A,I9))') 'CAL_ISLEAP: ',
45 & 'year=', year
46 CALL PRINT_ERROR( msgBuf, myThid )
47 WRITE( msgBuf,'(2A,I2,A)') 'CAL_ISLEAP: ',
48 & 'called too early (cal_setStatus=',cal_setStatus,' )'
49 CALL PRINT_ERROR( msgBuf, myThid )
50 STOP 'ABNORMAL END: FUNCTION CAL_ISLEAP'
51 ENDIF
52
53 if ( usingGregorianCalendar ) then
54 if ( mod(year,4) .ne. 0 ) then
55 cal_IsLeap = 1
56 else
57 cal_IsLeap = 2
58 if ( (mod(year,100) .eq. 0) .and.
59 & (mod(year,400) .ne. 0) ) then
60 cal_IsLeap = 1
61 endif
62 endif
63 else if ( usingJulianCalendar ) then
64 if ( mod(year,4) .ne. 0 ) then
65 cal_IsLeap = 1
66 else
67 cal_IsLeap = 2
68 endif
69 else
70 cal_IsLeap = 1
71 endif
72
73 RETURN
74 END
  ViewVC Help
Powered by ViewVC 1.1.22