C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/cal/cal_checkdate.F,v 1.6 2012/04/08 19:31:46 jmc Exp $ C $Name: checkpoint65o $ #include "CAL_OPTIONS.h" SUBROUTINE CAL_CHECKDATE( I date, O valid, O calerr, I myThid ) C ================================================================== C SUBROUTINE cal_CheckDate C ================================================================== C C o Check whether the array date conforms with the required format. C C started: Christian Eckert eckert@mit.edu 30-Jun-1999 C changed: Christian Eckert eckert@mit.edu 29-Dec-1999 C - restructured the original version in order to have a C better interface to the MITgcmUV. C Christian Eckert eckert@mit.edu 03-Feb-2000 C - Introduced new routine and function names, cal_, C for verion 0.1.3. C 21-Sep-2003: fixed check_sign logic to work with C negative intervals (menemenlis@jpl.nasa.gov) C C ================================================================== C SUBROUTINE cal_CheckDate C ================================================================== IMPLICIT NONE C == global variables == #include "EEPARAMS.h" #include "cal.h" C == routine arguments == INTEGER date(4) LOGICAL valid INTEGER calerr INTEGER myThid C == local variables == C msgBuf :: Informational/error message buffer INTEGER yy, mm, dd INTEGER nsecs INTEGER lp,wd INTEGER hh, mn, ss INTEGER hhmmss LOGICAL wrong_sign CHARACTER*(MAX_LEN_MBUF) msgBuf C == end of interface == valid = .true. calerr = 0 c wrong_sign = date(1)*date(2).lt.0 C product above might go over integer*4 limit; better to check each one: wrong_sign = ( (date(1).LT.0) .AND. date(2).GT.0 ) & .OR. ( (date(1).GT.0) .AND. date(2).LT.0 ) IF ( wrong_sign ) THEN C cal_CheckDate: Signs of first two components unequal calerr = 1803 C invalid sign is fatal (since we need to check for valid month) valid = .FALSE. ELSEIF ( cal_setStatus .LT. 1 ) THEN WRITE( msgBuf,'(2A,4I9)') 'CAL_CHECKDATE:', & ' date=',date(1),date(2),date(3),date(4) CALL PRINT_ERROR( msgBuf, myThid ) WRITE( msgBuf,'(2A,I2,A)') 'CAL_CHECKDATE:', & ' called too early (cal_setStatus=',cal_setStatus,' )' CALL PRINT_ERROR( msgBuf, myThid ) c valid = .FALSE. ELSEIF ( date(4).LE.0 ) THEN C-- date without weekday (date(4)= -1) and no LeapYear index (date(3)= 0) IF ( date(4).NE.-1 ) THEN C cal_CheckDate: Last component of array not valid calerr = 1801 ELSEIF ( date(3).NE.0 ) THEN C cal_CheckDate: Third component of interval array not 0 calerr = 1802 ENDIF ELSE C-- normal date with weekday (date(4)> 0) and LeapYear index (date(3)> 0) CALL CAL_CONVDATE( date, yy, mm, dd, nsecs, lp, wd, myThid ) IF ( mm.EQ.0 .OR. ABS(mm).GT.nMonthYear ) THEN WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:', & ' Invalid month in date(1)=', date(1) CALL PRINT_ERROR( msgBuf, myThid ) C invalid month is fatal (used as index in nDayMonth array) valid = .FALSE. ELSEIF ( wd.LT.1 .OR. wd.GT.7 ) THEN C cal_CheckDate: Weekday indentifier not correct calerr = 1805 C invalid weekday is not safe (index in dayOfWeek, but just to print) ELSEIF ( lp.NE.1 .AND. lp.NE.2 ) then C cal_CheckDate: Leap year identifier not correct calerr = 1806 C invalid leap-year index is fatal (used as index in nDayMonth array) valid = .FALSE. ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nMaxDayMonth ) THEN C-note: can refine above using Nb of days of the corresponding month: c ELSEIF ( dd.EQ.0 .OR. ABS(dd).GT.nDayMonth(mm,lp) ) THEN WRITE( msgBuf,'(2A,I10)') 'CAL_CHECKDATE:', & ' Invalid day in date(1)=', date(1) CALL PRINT_ERROR( msgBuf, myThid ) ELSEIF ( date(1).LT.refDate(1) ) THEN C cal_CheckDate: Calendar date before predef. reference date calerr = 1807 ENDIF ENDIF IF ( valid .AND. cal_setStatus.GE.1 ) THEN C-- check 2nd component (hhmmss=date(2)) and print warning hhmmss = ABS(date(2)) hh = hhmmss/10000 mn = MOD(hhmmss/100,100) ss = MOD(hhmmss,100) IF ( ss.GE.secondsPerMinute ) THEN WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:', & ' Invalid Seconds in date(2)=', date(2) CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid ) ENDIF IF ( mn.GE.minutesPerHour ) THEN WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:', & ' Invalid Minutes in date(2)=', date(2) CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid ) ENDIF IF ( hh.GE.hoursPerDay ) THEN WRITE( msgBuf,'(2A,I10)') '** WARNING ** CAL_CHECKDATE:', & ' Invalid Hours in date(2)=', date(2) CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid ) ENDIF ENDIF RETURN END