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

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

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

Revision 1.5 - (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.4: +30 -13 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.5 C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_fulldate.F,v 1.4 2012/04/07 16:21:05 jmc Exp $
2 edhill 1.2 C $Name: $
3 heimbach 1.1
4 edhill 1.2 #include "CAL_OPTIONS.h"
5 heimbach 1.1
6 jmc 1.4 SUBROUTINE CAL_FULLDATE(
7 heimbach 1.1 I yymmdd,
8     I hhmmss,
9     O date,
10 jmc 1.4 I myThid )
11 heimbach 1.1
12 jmc 1.4 C ==================================================================
13     C SUBROUTINE cal_FullDate
14     C ==================================================================
15     C
16     C o Set a date array given the year, month, day, hour, minute,
17     C and second. Check the input for errors.
18     C
19     C started: Christian Eckert eckert@mit.edu 30-Jun-1999
20     C changed: Christian Eckert eckert@mit.edu 29-Dec-1999
21     C - restructured the original version in order to have a
22     C better interface to the MITgcmUV.
23     C Christian Eckert eckert@mit.edu 03-Feb-2000
24     C - Introduced new routine and function names, cal_<NAME>,
25     C for verion 0.1.3.
26     C
27     C ==================================================================
28     C SUBROUTINE cal_FullDate
29     C ==================================================================
30 heimbach 1.1
31 jmc 1.4 IMPLICIT NONE
32 heimbach 1.1
33 jmc 1.4 C == global variables ==
34     #include "EEPARAMS.h"
35 heimbach 1.1 #include "cal.h"
36    
37 jmc 1.4 C == routine arguments ==
38     C myThid - thread number for this instance of the routine.
39     INTEGER yymmdd
40     INTEGER hhmmss
41     INTEGER date(4)
42     INTEGER myThid
43    
44     C == functions ==
45     INTEGER cal_IsLeap
46     EXTERNAL cal_IsLeap
47    
48     C == local variables ==
49     INTEGER theyear
50 jmc 1.5 INTEGER numberOfDays(4)
51 jmc 1.4 INTEGER calerr
52     LOGICAL valid
53     CHARACTER*(MAX_LEN_MBUF) msgBuf
54     C == end of interface ==
55 heimbach 1.1
56     date(1) = yymmdd
57     date(2) = hhmmss
58     date(3) = 1
59     date(4) = 1
60    
61 jmc 1.4 IF ( cal_setStatus .LT. 1 ) THEN
62     WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
63     & 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
64     CALL PRINT_ERROR( msgBuf, myThid )
65     WRITE( msgBuf,'(2A,I2,A)') 'CAL_FULLDATE: ',
66     & 'called too early (cal_setStatus=',cal_setStatus,' )'
67     CALL PRINT_ERROR( msgBuf, myThid )
68     STOP 'ABNORMAL END: S/R CAL_FULLDATE'
69     ENDIF
70    
71     C Check the input for obvious errors.
72 jmc 1.5 CALL CAL_CHECKDATE( date, valid, calerr, myThid )
73     IF ( calerr.NE.0 ) THEN
74     WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
75     & 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
76     CALL PRINT_ERROR( msgBuf, myThid )
77     CALL CAL_PRINTERROR( calerr, myThid )
78     ENDIF
79 heimbach 1.1
80 jmc 1.5 IF (valid) THEN
81 jmc 1.4 C Determine whether we are in a leap year or not.
82 heimbach 1.1 theyear = yymmdd/10000
83 jmc 1.4 date(3) = cal_IsLeap( theyear, myThid )
84 heimbach 1.1
85 jmc 1.4 C Determine the day of the week.
86 jmc 1.5 CALL CAL_TIMEPASSED( refDate, date, numberOfDays, myThid )
87     IF ( numberOfDays(1).LT.0 ) THEN
88     C- when numberOfDays < 0 , TIMEPASSED output is not very logical (print);
89     C in addition, in this case, formula below is wrong (skipped).
90     WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
91     & 'refDate=', refDate(1), refDate(2), refDate(3), refDate(4)
92     WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
93     & ' date=', date(1), date(2), date(3), date(4)
94     WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
95     & 'numDays=', numberOfDays(1), numberOfDays(2),
96     & numberOfDays(3), numberOfDays(4)
97     ELSE
98     date(4) = MOD(numberOfDays(1),7)+1
99     ENDIF
100     ELSE
101     WRITE( msgBuf,'(2A)') 'CAL_FULLDATE: ',
102     & 'fatal error from cal_CheckDate'
103     CALL PRINT_ERROR( msgBuf, myThid )
104     STOP 'ABNORMAL END: S/R CAL_FULLDATE'
105     ENDIF
106 heimbach 1.1
107 jmc 1.4 RETURN
108     END
  ViewVC Help
Powered by ViewVC 1.1.22