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

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

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

revision 1.3 by mlosch, Mon Apr 19 23:25:15 2004 UTC revision 1.4 by jmc, Sat Apr 7 16:21:05 2012 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CAL_OPTIONS.h"  #include "CAL_OPTIONS.h"
5    
6        subroutine cal_FullDate(        SUBROUTINE CAL_FULLDATE(
7       I                         yymmdd,       I                         yymmdd,
8       I                         hhmmss,       I                         hhmmss,
9       O                         date,       O                         date,
10       I                         mythid       I                         myThid )
      &                       )  
11    
12  c     ==================================================================  C     ==================================================================
13  c     SUBROUTINE cal_FullDate  C     SUBROUTINE cal_FullDate
14  c     ==================================================================  C     ==================================================================
15  c  C
16  c     o Set a date array given the year, month, day, hour, minute,  C     o Set a date array given the year, month, day, hour, minute,
17  c       and second. Check the input for errors.  C       and second. Check the input for errors.
18  c  C
19  c                C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
20  c     started: Christian Eckert eckert@mit.edu  30-Jun-1999  C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
21  c  C              - restructured the original version in order to have a
22  c     changed: Christian Eckert eckert@mit.edu  29-Dec-1999  C                better interface to the MITgcmUV.
23  c  C              Christian Eckert eckert@mit.edu  03-Feb-2000
24  c              - restructured the original version in order to have a  C              - Introduced new routine and function names, cal_<NAME>,
25  c                better interface to the MITgcmUV.  C                for verion 0.1.3.
26  c  C
27  c              Christian Eckert eckert@mit.edu  03-Feb-2000  C     ==================================================================
28  c  C     SUBROUTINE cal_FullDate
29  c              - Introduced new routine and function names, cal_<NAME>,  C     ==================================================================
 c                for verion 0.1.3.  
 c  
 c     ==================================================================  
 c     SUBROUTINE cal_FullDate  
 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    C     myThid - thread number for this instance of the routine.
39  c     mythid - thread number for this instance of the routine.        INTEGER yymmdd
40          INTEGER hhmmss
41        integer yymmdd        INTEGER date(4)
42        integer hhmmss        INTEGER myThid
43        integer date(4)  
44        integer mythid  C     == functions ==
45          INTEGER  cal_IsLeap
46  c     == local variables ==        EXTERNAL cal_IsLeap
47    
48        integer theyear  C     == local variables ==
49        integer numberofdays(4)        INTEGER theyear
50        integer calerr        INTEGER numberofdays(4)
51          INTEGER calerr
52        logical valid        LOGICAL valid
53          CHARACTER*(MAX_LEN_MBUF) msgBuf
54        integer  cal_IsLeap  C     == end of interface ==
       external cal_IsLeap  
   
 c     == end of interface ==  
55    
56        date(1) = yymmdd        date(1) = yymmdd
57        date(2) = hhmmss        date(2) = hhmmss
58        date(3) = 1        date(3) = 1
59        date(4) = 1        date(4) = 1
60    
61  c     Check the input for obvious errors.        IF ( cal_setStatus .LT. 1 ) THEN
62        call cal_CheckDate( date, valid, calerr, mythid )          WRITE( msgBuf,'(A,2(A,I9))')  'CAL_FULLDATE: ',
63         &          'yymmdd=',yymmdd,' , hhmmss=',hhmmss
64            CALL PRINT_ERROR( msgBuf, myThid )
65            WRITE( msgBuf,'(2A,I2,A)') 'CAL_FULLDATE: ',
66         &    'called too early (cal_setStatus=',cal_setStatus,' )'
67            CALL PRINT_ERROR( msgBuf, myThid )
68            STOP 'ABNORMAL END: S/R CAL_FULLDATE'
69          ENDIF
70    
71    C     Check the input for obvious errors.
72          call cal_CheckDate( date, valid, calerr, myThid )
73    
74        if (valid) then        if (valid) then
75  c       Determine whether we are in a leap year or not.  C       Determine whether we are in a leap year or not.
76          theyear = yymmdd/10000          theyear = yymmdd/10000
77          date(3) = cal_IsLeap( theyear, mythid )          date(3) = cal_IsLeap( theyear, myThid )
78    
79  c       Determine the day of the week.  C       Determine the day of the week.
80          call cal_TimePassed( refdate, date, numberofdays, mythid )          call cal_TimePassed( refdate, date, numberofdays, myThid )
81          date(4) = mod(numberofdays(1),7)+1          date(4) = mod(numberofdays(1),7)+1
82        else        else
83          call cal_PrintError( calerr, mythid )          call cal_PrintError( calerr, myThid )
84  cml   if you want the CheckDate error to stop the model uncomment  cml   if you want the CheckDate error to stop the model uncomment
85  cml   the following line, otherwise there is just going to be a  cml   the following line, otherwise there is just going to be a
86  cml   warning.  cml   warning.
87  cml        stop ' stopped in cal_FullDate'  cml        stop ' stopped in cal_FullDate'
88        endif        endif
89    
90        return        RETURN
91        end        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22