pkg/cal/cal_getdate.F

6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
238c10755b Jean*0003       SUBROUTINE CAL_GETDATE(
                0004      I                        myIter,
                0005      I                        myTime,
a63ed37559 Patr*0006      O                        mydate,
238c10755b Jean*0007      I                        myThid )
a63ed37559 Patr*0008
238c10755b Jean*0009 C     ==================================================================
                0010 C     SUBROUTINE cal_GetDate
                0011 C     ==================================================================
                0012 C
                0013 C     o Determine the current date given the iteration number and/or the
                0014 C       current time of integration.
4ef07e16db Jean*0015 C     <- changed to be function of current time only (less ambiguous)
238c10755b Jean*0016 C
                0017 C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0018 C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0019 C              - restructured the original version in order to have a
                0020 C                better interface to the MITgcmUV.
                0021 C              Christian Eckert eckert@mit.edu  03-Feb-2000
                0022 C              - Introduced new routine and function names, cal_<NAME>,
                0023 C                for verion 0.1.3.
                0024 C
                0025 C     ==================================================================
                0026 C     SUBROUTINE cal_GetDate
                0027 C     ==================================================================
a63ed37559 Patr*0028
238c10755b Jean*0029       IMPLICIT NONE
a63ed37559 Patr*0030
238c10755b Jean*0031 C     == global variables ==
                0032 #include "EEPARAMS.h"
                0033 #include "cal.h"
a63ed37559 Patr*0034
238c10755b Jean*0035 C     == routine arguments ==
                0036       INTEGER myIter
                0037       _RL     myTime
                0038       INTEGER mydate(4)
                0039       INTEGER myThid
a63ed37559 Patr*0040
238c10755b Jean*0041 C     == local variables ==
a63ed37559 Patr*0042       _RL     secs
238c10755b Jean*0043       INTEGER workdate(4)
                0044       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0045 C     == end of interface ==
                0046
                0047       IF ( myIter .EQ. -1 ) THEN
                0048
                0049 C-    Special case to return starDate_1 & _2 :
                0050         mydate(1) = startdate_1
                0051         mydate(2) = startdate_2
                0052         mydate(3) = 1
                0053         mydate(4) = 1
                0054
                0055       ELSEIF ( cal_setStatus .LT. 3 ) THEN
                0056
1830bfbaf4 Jean*0057         WRITE( msgBuf,'(2A,I10,A,F19.2)') 'CAL_GETDATE: ',
238c10755b Jean*0058      &       'myIter=', myIter, ' , myTime=', myTime
                0059         CALL PRINT_ERROR( msgBuf, myThid )
                0060         WRITE( msgBuf,'(2A,I2,A)') 'CAL_GETDATE: ',
                0061      &    'called too early (cal_setStatus=',cal_setStatus,' )'
                0062         CALL PRINT_ERROR( msgBuf, myThid )
                0063         STOP 'ABNORMAL END: S/R CAL_GETDATE'
                0064
4ef07e16db Jean*0065 c     ELSEIF ( myIter.EQ.modelIter0 .OR. myTime.EQ.modelStart ) THEN
                0066       ELSEIF ( myTime.EQ.modelStart ) THEN
238c10755b Jean*0067
4ef07e16db Jean*0068 C-    faster to just copy modelStartDate:
                0069         mydate(1) = modelStartDate(1)
                0070         mydate(2) = modelStartDate(2)
                0071         mydate(3) = modelStartDate(3)
                0072         mydate(4) = modelStartDate(4)
a63ed37559 Patr*0073
238c10755b Jean*0074       ELSE
a63ed37559 Patr*0075
4ef07e16db Jean*0076 c       if ( myTime.lt.0. ) then
                0077 c         if (myIter .ge. 0) then
                0078 c           secs = float(myIter - modelIter0)*modelStep
                0079 c         else
                0080 c           print*,' cal_GetDate: Not a valid input!'
                0081 c           STOP 'ABNORMAL END: S/R CAL_GETDATE'
                0082 c         endif
                0083 c       else
                0084           secs = myTime - modelStart
                0085 c       endif
                0086
                0087         CALL CAL_TIMEINTERVAL( secs, 'secs', workdate, myThid )
                0088         CALL CAL_ADDTIME( modelStartDate, workdate, mydate, myThid )
a63ed37559 Patr*0089
238c10755b Jean*0090       ENDIF
a63ed37559 Patr*0091
238c10755b Jean*0092       RETURN
                0093       END