Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:38:15 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 
d0c66b198b Jean*0003       SUBROUTINE CAL_FULLDATE(
a63ed37559 Patr*0004      I                         yymmdd,
                0005      I                         hhmmss,
                0006      O                         date,
d0c66b198b Jean*0007      I                         myThid )
                0008 
                0009 C     ==================================================================
                0010 C     SUBROUTINE cal_FullDate
                0011 C     ==================================================================
                0012 C
                0013 C     o Set a date array given the year, month, day, hour, minute,
                0014 C       and second. Check the input for errors.
                0015 C
                0016 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0017 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0018 C              - restructured the original version in order to have a
                0019 C                better interface to the MITgcmUV.
                0020 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0021 C              - Introduced new routine and function names, cal_<NAME>,
                0022 C                for verion 0.1.3.
                0023 C
                0024 C     ==================================================================
                0025 C     SUBROUTINE cal_FullDate
                0026 C     ==================================================================
                0027 
                0028       IMPLICIT NONE
                0029 
                0030 C     == global variables ==
                0031 #include "EEPARAMS.h"
a63ed37559 Patr*0032 #include "cal.h"
                0033 
d0c66b198b Jean*0034 C     == routine arguments ==
                0035 C     myThid - thread number for this instance of the routine.
                0036       INTEGER yymmdd
                0037       INTEGER hhmmss
                0038       INTEGER date(4)
                0039       INTEGER myThid
                0040 
                0041 C     == functions ==
                0042       INTEGER  cal_IsLeap
                0043       EXTERNAL cal_IsLeap
                0044 
                0045 C     == local variables ==
                0046       INTEGER theyear
12fd5e6104 Jean*0047       INTEGER numberOfDays(4)
d0c66b198b Jean*0048       INTEGER calerr
                0049       LOGICAL valid
                0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051 C     == end of interface ==
a63ed37559 Patr*0052 
                0053       date(1) = yymmdd
                0054       date(2) = hhmmss
                0055       date(3) = 1
                0056       date(4) = 1
                0057 
d0c66b198b Jean*0058       IF ( cal_setStatus .LT. 1 ) THEN
                0059         WRITE( msgBuf,'(A,2(A,I9))')  'CAL_FULLDATE: ',
                0060      &          'yymmdd=',yymmdd,' , hhmmss=',hhmmss
                0061         CALL PRINT_ERROR( msgBuf, myThid )
                0062         WRITE( msgBuf,'(2A,I2,A)') 'CAL_FULLDATE: ',
                0063      &    'called too early (cal_setStatus=',cal_setStatus,' )'
                0064         CALL PRINT_ERROR( msgBuf, myThid )
                0065         STOP 'ABNORMAL END: S/R CAL_FULLDATE'
                0066       ENDIF
                0067 
                0068 C     Check the input for obvious errors.
12fd5e6104 Jean*0069       CALL CAL_CHECKDATE( date, valid, calerr, myThid )
                0070       IF ( calerr.NE.0 ) THEN
                0071         WRITE( msgBuf,'(A,2(A,I9))')  'CAL_FULLDATE: ',
                0072      &          'yymmdd=',yymmdd,' , hhmmss=',hhmmss
                0073         CALL PRINT_ERROR( msgBuf, myThid )
                0074         CALL CAL_PRINTERROR( calerr, myThid )
                0075       ENDIF
a63ed37559 Patr*0076 
12fd5e6104 Jean*0077       IF (valid) THEN
d0c66b198b Jean*0078 C       Determine whether we are in a leap year or not.
a63ed37559 Patr*0079         theyear = yymmdd/10000
d0c66b198b Jean*0080         date(3) = cal_IsLeap( theyear, myThid )
a63ed37559 Patr*0081 
d0c66b198b Jean*0082 C       Determine the day of the week.
12fd5e6104 Jean*0083         CALL CAL_TIMEPASSED( refDate, date, numberOfDays, myThid )
                0084         IF ( numberOfDays(1).LT.0 ) THEN
                0085 C-      when numberOfDays < 0 ,  TIMEPASSED output is not very logical (print);
                0086 C       in addition, in this case, formula below is wrong (skipped).
                0087           WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
                0088      &     'refDate=', refDate(1), refDate(2), refDate(3), refDate(4)
                0089           WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
                0090      &     '   date=', date(1), date(2), date(3), date(4)
                0091           WRITE(errorMessageUnit,'(2A,4I9)') ' in CAL_FULLDATE: ',
                0092      &     'numDays=', numberOfDays(1), numberOfDays(2),
                0093      &                 numberOfDays(3), numberOfDays(4)
                0094         ELSE
                0095           date(4) = MOD(numberOfDays(1),7)+1
                0096         ENDIF
                0097       ELSE
                0098         WRITE( msgBuf,'(2A)') 'CAL_FULLDATE: ',
                0099      &    'fatal error from cal_CheckDate'
                0100         CALL PRINT_ERROR( msgBuf, myThid )
                0101         STOP 'ABNORMAL END: S/R CAL_FULLDATE'
                0102       ENDIF
a63ed37559 Patr*0103 
d0c66b198b Jean*0104       RETURN
                0105       END