C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_fulldate.F,v 1.5 2012/04/08 19:31:46 jmc Exp $
C $Name: $
#include "CAL_OPTIONS.h"
SUBROUTINE CAL_FULLDATE(
I yymmdd,
I hhmmss,
O date,
I myThid )
C ==================================================================
C SUBROUTINE cal_FullDate
C ==================================================================
C
C o Set a date array given the year, month, day, hour, minute,
C and second. Check the input for errors.
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
C ==================================================================
C SUBROUTINE cal_FullDate
C ==================================================================
IMPLICIT NONE
C == global variables ==
#include "EEPARAMS.h"
#include "cal.h"
C == routine arguments ==
C myThid - thread number for this instance of the routine.
INTEGER yymmdd
INTEGER hhmmss
INTEGER date(4)
INTEGER myThid
C == functions ==
INTEGER cal_IsLeap
EXTERNAL
C == local variables ==
INTEGER theyear
INTEGER numberOfDays(4)
INTEGER calerr
LOGICAL valid
CHARACTER*(MAX_LEN_MBUF) msgBuf
C == end of interface ==
date(1) = yymmdd
date(2) = hhmmss
date(3) = 1
date(4) = 1
IF ( cal_setStatus .LT. 1 ) THEN
WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
& 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
CALL PRINT_ERROR( msgBuf, myThid )
WRITE( msgBuf,'(2A,I2,A)') 'CAL_FULLDATE: ',
& 'called too early (cal_setStatus=',cal_setStatus,' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R CAL_FULLDATE'
ENDIF
C Check the input for obvious errors.
CALL CAL_CHECKDATE( date, valid, calerr, myThid )
IF ( calerr.NE.0 ) THEN
WRITE( msgBuf,'(A,2(A,I9))') 'CAL_FULLDATE: ',
& 'yymmdd=',yymmdd,' , hhmmss=',hhmmss
CALL PRINT_ERROR( msgBuf, myThid )
CALL CAL_PRINTERROR( calerr, myThid )
ENDIF
IF (valid) THEN
C Determine whether we are in a leap year or not.
theyear = yymmdd/10000
date(3) = cal_IsLeap( theyear, myThid )
C Determine the day of the week.
CALL CAL_TIMEPASSED( refDate, date, numberOfDays, myThid )
IF ( numberOfDays(1).LT.0 ) THEN
C- when numberOfDays < 0 , TIMEPASSED output is not very logical (print);
C in addition, in this case, formula below is wrong (skipped).
WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
& 'refDate=', refDate(1), refDate(2), refDate(3), refDate(4)
WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
& ' date=', date(1), date(2), date(3), date(4)
WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
& 'numDays=', numberOfDays(1), numberOfDays(2),
& numberOfDays(3), numberOfDays(4)
ELSE
date(4) = MOD(numberOfDays(1),7)+1
ENDIF
ELSE
WRITE( msgBuf,'(2A)') 'CAL_FULLDATE: ',
& 'fatal error from cal_CheckDate'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R CAL_FULLDATE'
ENDIF
RETURN
END