/[MITgcm]/MITgcm/pkg/cal/cal_getdate.F
ViewVC logotype

Diff of /MITgcm/pkg/cal/cal_getdate.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by heimbach, Mon May 14 22:07:26 2001 UTC revision 1.5 by jmc, Sat Apr 7 22:02:11 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CAL_CPPOPTIONS.h"  #include "CAL_OPTIONS.h"
5    
6        subroutine cal_GetDate(        SUBROUTINE CAL_GETDATE(
7       I                        myiter,       I                        myIter,
8       I                        mytime,       I                        myTime,
9       O                        mydate,       O                        mydate,
10       I                        mythid       I                        myThid )
      &                      )  
11    
12  c     ==================================================================  C     ==================================================================
13  c     SUBROUTINE cal_GetDate  C     SUBROUTINE cal_GetDate
14  c     ==================================================================  C     ==================================================================
15  c  C
16  c     o Determine the current date given the iteration number and/or the  C     o Determine the current date given the iteration number and/or the
17  c       current time of integration.  C       current time of integration.
18  c                C
19  c     started: Christian Eckert eckert@mit.edu  30-Jun-1999  C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
20  c  C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
21  c     changed: Christian Eckert eckert@mit.edu  29-Dec-1999  C              - restructured the original version in order to have a
22  c  C                better interface to the MITgcmUV.
23  c              - restructured the original version in order to have a  C              Christian Eckert eckert@mit.edu  03-Feb-2000
24  c                better interface to the MITgcmUV.  C              - Introduced new routine and function names, cal_<NAME>,
25  c  C                for verion 0.1.3.
26  c              Christian Eckert eckert@mit.edu  03-Feb-2000  C
27  c  C     ==================================================================
28  c              - Introduced new routine and function names, cal_<NAME>,  C     SUBROUTINE cal_GetDate
29  c                for verion 0.1.3.  C     ==================================================================
 c  
 c     ==================================================================  
 c     SUBROUTINE cal_GetDate  
 c     ==================================================================  
30    
31        implicit none        IMPLICIT NONE
   
 c     == global variables ==  
32    
33    C     == global variables ==
34    #include "EEPARAMS.h"
35  #include "cal.h"  #include "cal.h"
36    
37  c     == routine arguments ==  C     == routine arguments ==
38          INTEGER myIter
39        integer myiter        _RL     myTime
40        _RL     mytime        INTEGER mydate(4)
41        integer mydate(4)        INTEGER myThid
       integer mythid  
   
 c     == local variables ==  
42    
43    C     == local variables ==
44        _RL     secs        _RL     secs
45        integer workdate(4)        INTEGER workdate(4)
46          CHARACTER*(MAX_LEN_MBUF) msgBuf
47  c     == end of interface ==  C     == end of interface ==
48    
49        if (mytime .lt. 0) then        IF ( myIter .EQ. -1 ) THEN
50          if (myiter .ge. 0) then  
51            secs = float(myiter - modeliter0)*modelstep  C-    Special case to return starDate_1 & _2 :
52            mydate(1) = startdate_1
53            mydate(2) = startdate_2
54            mydate(3) = 1
55            mydate(4) = 1
56    
57          ELSEIF ( cal_setStatus .LT. 3 ) THEN
58    
59            WRITE( msgBuf,'(2A,I10,A,F19.2)') 'CAL_GETDATE: ',
60         &       'myIter=', myIter, ' , myTime=', myTime
61            CALL PRINT_ERROR( msgBuf, myThid )
62            WRITE( msgBuf,'(2A,I2,A)') 'CAL_GETDATE: ',
63         &    'called too early (cal_setStatus=',cal_setStatus,' )'
64            CALL PRINT_ERROR( msgBuf, myThid )
65            STOP 'ABNORMAL END: S/R CAL_GETDATE'
66    
67          ELSEIF ( myIter.EQ.modeliter0 .OR. myTime.EQ.modelstart ) THEN
68    
69    C-    faster to just copy modelstartdate:
70            mydate(1) = modelstartdate(1)
71            mydate(2) = modelstartdate(2)
72            mydate(3) = modelstartdate(3)
73            mydate(4) = modelstartdate(4)
74    
75          ELSE
76    
77            if (myTime .lt. 0) then
78              if (myIter .ge. 0) then
79                secs = float(myIter - modeliter0)*modelstep
80              else
81                print*,' cal_GetDate: Not a valid input!'
82                STOP 'ABNORMAL END: S/R CAL_GETDATE'
83              endif
84          else          else
85            print*,' cal_GetDate: Not a valid input!'            secs = myTime - modelstart
86          endif          endif
       else  
         secs = mytime - modelstart  
       endif  
87    
88        call cal_TimeInterval( secs, 'secs', workdate, mythid )          call cal_TimeInterval( secs, 'secs', workdate, myThid )
89        call cal_AddTime( modelstartdate, workdate, mydate, mythid )          call cal_AddTime( modelstartdate, workdate, mydate, myThid )
90    
91        return        ENDIF
       end  
92    
93          RETURN
94          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22