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

Annotation of /MITgcm/pkg/cal/cal_checkdate.F

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

Revision 1.6 - (hide annotations) (download)
Sun Apr 8 19:31:46 2012 UTC (12 years, 1 month 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.5: +87 -77 lines 
improve date checking:
- fatal error returns valid=F ; otherwise, just print warning/error msg.
- check for valid month and stop if not (cause out-of bounds error);
- stop if sign error or wrong Leap year index;
- add warning if date 2nd comp. (hhmmss) is not valid.
1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_checkdate.F,v 1.5 2012/04/07 16:20:07 jmc Exp $
2 edhill 1.4 C $Name: $
3 heimbach 1.1
4 edhill 1.4 #include "CAL_OPTIONS.h"
5 heimbach 1.1
6 jmc 1.5 SUBROUTINE CAL_CHECKDATE(
7 heimbach 1.1 I date,
8     O valid,
9     O calerr,
10 jmc 1.5 I myThid )
11 heimbach 1.1
12 jmc 1.5 C ==================================================================
13     C SUBROUTINE cal_CheckDate
14     C ==================================================================
15     C
16     C o Check whether the array date conforms with the required format.
17     C
18     C started: Christian Eckert eckert@mit.edu 30-Jun-1999
19     C changed: Christian Eckert eckert@mit.edu 29-Dec-1999
20     C - restructured the original version in order to have a
21     C better interface to the MITgcmUV.
22     C Christian Eckert eckert@mit.edu 03-Feb-2000
23     C - Introduced new routine and function names, cal_<NAME>,
24     C for verion 0.1.3.
25     C 21-Sep-2003: fixed check_sign logic to work with
26     C negative intervals (menemenlis@jpl.nasa.gov)
27     C
28     C ==================================================================
29     C SUBROUTINE cal_CheckDate
30     C ==================================================================
31 heimbach 1.1
32 jmc 1.5 IMPLICIT NONE
33 heimbach 1.1
34 jmc 1.5 C == global variables ==
35     #include "EEPARAMS.h"
36 heimbach 1.1 #include "cal.h"
37    
38 jmc 1.5 C == routine arguments ==
39     INTEGER date(4)
40     LOGICAL valid
41     INTEGER calerr
42     INTEGER myThid
43    
44     C == local variables ==
45     C msgBuf :: Informational/error message buffer
46 jmc 1.6 INTEGER yy, mm, dd
47 jmc 1.5 INTEGER nsecs
48     INTEGER lp,wd
49 jmc 1.6 INTEGER hh, mn, ss
50 jmc 1.5 INTEGER hhmmss
51 jmc 1.6 LOGICAL wrong_sign
52 jmc 1.5 CHARACTER*(MAX_LEN_MBUF) msgBuf
53     C == end of interface ==
54 heimbach 1.1
55     valid = .true.
56     calerr = 0
57 jmc 1.6 c wrong_sign = date(1)*date(2).lt.0
58     C product above might go over integer*4 limit; better to check each one:
59     wrong_sign = ( (date(1).LT.0) .AND. date(2).GT.0 )
60     & .OR. ( (date(1).GT.0) .AND. date(2).LT.0 )
61    
62     IF ( wrong_sign ) THEN
63     C cal_CheckDate: Signs of first two components unequal
64     calerr = 1803
65     C invalid sign is fatal (since we need to check for valid month)
66     valid = .FALSE.
67     ELSEIF ( cal_setStatus .LT. 1 ) THEN
68     WRITE( msgBuf,'(2A,4I9)') 'CAL_CHECKDATE:',
69     & ' date=',date(1),date(2),date(3),date(4)
70     CALL PRINT_ERROR( msgBuf, myThid )
71     WRITE( msgBuf,'(2A,I2,A)') 'CAL_CHECKDATE:',
72     & ' called too early (cal_setStatus=',cal_setStatus,' )'
73     CALL PRINT_ERROR( msgBuf, myThid )
74     c valid = .FALSE.
75 heimbach 1.1
76 jmc 1.6 ELSEIF ( date(4).LE.0 ) THEN
77     C-- date without weekday (date(4)= -1) and no LeapYear index (date(3)= 0)
78 dimitri 1.3
79 jmc 1.6 IF ( date(4).NE.-1 ) THEN
80     C cal_CheckDate: Last component of array not valid
81 heimbach 1.1 calerr = 1801
82 jmc 1.6 ELSEIF ( date(3).NE.0 ) THEN
83     C cal_CheckDate: Third component of interval array not 0
84     calerr = 1802
85     ENDIF
86    
87     ELSE
88     C-- normal date with weekday (date(4)> 0) and LeapYear index (date(3)> 0)
89    
90     CALL CAL_CONVDATE( date, yy, mm, dd, nsecs, lp, wd, myThid )
91     IF ( mm.EQ.0 .OR. ABS(mm).GT.nMonthYear ) THEN
92     WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:',
93     & ' Invalid month in date(1)=', date(1)
94     CALL PRINT_ERROR( msgBuf, myThid )
95     C invalid month is fatal (used as index in nDayMonth array)
96     valid = .FALSE.
97     ELSEIF ( wd.LT.1 .OR. wd.GT.7 ) THEN
98     C cal_CheckDate: Weekday indentifier not correct
99 heimbach 1.1 calerr = 1805
100 jmc 1.6 C invalid weekday is not safe (index in dayOfWeek, but just to print)
101     ELSEIF ( lp.NE.1 .AND. lp.NE.2 ) then
102     C cal_CheckDate: Leap year identifier not correct
103     calerr = 1806
104     C invalid leap-year index is fatal (used as index in nDayMonth array)
105     valid = .FALSE.
106     ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nMaxDayMonth ) THEN
107     C-note: can refine above using Nb of days of the corresponding month:
108     c ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nDayMonth(mm,lp) ) THEN
109     WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:',
110     & ' Invalid day in date(1)=', date(1)
111     CALL PRINT_ERROR( msgBuf, myThid )
112     ELSEIF ( date(1).LT.refDate(1) ) THEN
113     C cal_CheckDate: Calendar date before predef. reference date
114     calerr = 1807
115     ENDIF
116    
117     ENDIF
118    
119     IF ( valid .AND. cal_setStatus.GE.1 ) THEN
120     C-- check 2nd component (hhmmss=date(2)) and print warning
121     hhmmss = ABS(date(2))
122     hh = hhmmss/10000
123     mn = MOD(hhmmss/100,100)
124     ss = MOD(hhmmss,100)
125     IF ( ss.GE.secondsPerMinute ) THEN
126     WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
127     & ' Invalid Seconds in date(2)=', date(2)
128     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
129     & SQUEEZE_RIGHT, myThid )
130     ENDIF
131     IF ( mn.GE.minutesPerHour ) THEN
132     WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
133     & ' Invalid Minutes in date(2)=', date(2)
134     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
135     & SQUEEZE_RIGHT, myThid )
136     ENDIF
137     IF ( hh.GE.hoursPerDay ) THEN
138     WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:',
139     & ' Invalid Hours in date(2)=', date(2)
140     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
141     & SQUEEZE_RIGHT, myThid )
142     ENDIF
143     ENDIF
144 heimbach 1.1
145 jmc 1.5 RETURN
146     END
  ViewVC Help
Powered by ViewVC 1.1.22