Back to home page

MITgcm

 
 

    


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 C     ==================================================================
                0010 C     SUBROUTINE cal_CheckDate
                0011 C     ==================================================================
                0012 C
                0013 C     o Check whether the array date conforms with the required format.
                0014 C
                0015 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0016 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0017 C              - restructured the original version in order to have a
                0018 C                better interface to the MITgcmUV.
                0019 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0020 C              - Introduced new routine and function names, cal_<NAME>,
                0021 C                for verion 0.1.3.
                0022 C              21-Sep-2003: fixed check_sign logic to work with
                0023 C              negative intervals (menemenlis@jpl.nasa.gov)
                0024 C
                0025 C     ==================================================================
                0026 C     SUBROUTINE cal_CheckDate
                0027 C     ==================================================================
                0028 
                0029       IMPLICIT NONE
                0030 
                0031 C     == global variables ==
                0032 #include "EEPARAMS.h"
a63ed37559 Patr*0033 #include "cal.h"
                0034 
af7f17a6b1 Jean*0035 C     == routine arguments ==
                0036       INTEGER date(4)
                0037       LOGICAL valid
                0038       INTEGER calerr
                0039       INTEGER myThid
                0040 
                0041 C     == local variables ==
                0042 C     msgBuf     :: Informational/error message buffer
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 C     == end of interface ==
a63ed37559 Patr*0051 
                0052       valid  = .true.
                0053       calerr = 0
12fd5e6104 Jean*0054 c     wrong_sign = date(1)*date(2).lt.0
                0055 C     product above might go over integer*4 limit; better to check each one:
                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 C         cal_CheckDate: Signs of first two components unequal
                0061           calerr = 1803
                0062 C         invalid sign is fatal (since we need to check for valid month)
                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 c         valid = .FALSE.
b52b3e8d0d Dimi*0072 
12fd5e6104 Jean*0073       ELSEIF ( date(4).LE.0 ) THEN
                0074 C--   date without weekday (date(4)= -1) and no LeapYear index (date(3)= 0)
                0075 
                0076         IF ( date(4).NE.-1 ) THEN
                0077 C         cal_CheckDate: Last component of array not valid
a63ed37559 Patr*0078           calerr = 1801
12fd5e6104 Jean*0079         ELSEIF ( date(3).NE.0 ) THEN
                0080 C         cal_CheckDate: Third component of interval array not 0
                0081           calerr = 1802
                0082         ENDIF
                0083 
                0084       ELSE
                0085 C--   normal date with weekday (date(4)> 0) and LeapYear index (date(3)> 0)
                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 C       invalid month is fatal (used as index in nDayMonth array)
                0093           valid = .FALSE.
                0094         ELSEIF ( wd.LT.1 .OR. wd.GT.7 ) THEN
                0095 C         cal_CheckDate: Weekday indentifier not correct
a63ed37559 Patr*0096           calerr = 1805
12fd5e6104 Jean*0097 C       invalid weekday is not safe (index in dayOfWeek, but just to print)
                0098         ELSEIF ( lp.NE.1 .AND. lp.NE.2 ) then
                0099 C         cal_CheckDate: Leap year identifier not correct
                0100           calerr = 1806
                0101 C       invalid leap-year index is fatal (used as index in nDayMonth array)
                0102           valid = .FALSE.
                0103         ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nMaxDayMonth ) THEN
                0104 C-note: can refine above using Nb of days of the corresponding month:
                0105 c       ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nDayMonth(mm,lp) ) THEN
                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 C         cal_CheckDate: Calendar date before predef. reference date
                0111           calerr = 1807
                0112         ENDIF
                0113 
                0114       ENDIF
                0115 
                0116       IF ( valid .AND. cal_setStatus.GE.1 ) THEN
                0117 C--   check 2nd component (hhmmss=date(2)) and print warning
                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