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

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

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

revision 1.4 by edhill, Thu Oct 9 04:19:19 2003 UTC revision 1.5 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_ConvDate(        SUBROUTINE CAL_CONVDATE(
7       I                         date,       I                         date,
8       O                         yy, mm, dd, ss,       O                         yy, mm, dd, ss,
9       O                         lp, wd,       O                         lp, wd,
10       I                         mythid       I                         myThid )
      &                       )  
11    
12  c     ==================================================================  C     ==================================================================
13  c     SUBROUTINE cal_ConvDate  C     SUBROUTINE cal_ConvDate
14  c     ==================================================================  C     ==================================================================
15  c  C
16  c     o Decompose the first part of a date array.  C     o Decompose the first part of a date array.
17  c                C
18  c     started: Christian Eckert eckert@mit.edu  30-Jun-1999  C     started: Christian Eckert eckert@mit.edu  30-Jun-1999
19  c  C     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
20  c     changed: Christian Eckert eckert@mit.edu  29-Dec-1999  C              - restructured the original version in order to have a
21  c  C                better interface to the MITgcmUV.
22  c              - restructured the original version in order to have a  C              Christian Eckert eckert@mit.edu  03-Feb-2000
23  c                better interface to the MITgcmUV.  C              - Introduced new routine and function names, cal_<NAME>,
24  c  C                for verion 0.1.3.
25  c              Christian Eckert eckert@mit.edu  03-Feb-2000  C              21-Sep-2003: fixed check_sign logic to work with
26  c  C              negative intervals (menemenlis@jpl.nasa.gov)
27  c              - Introduced new routine and function names, cal_<NAME>,  C
28  c                for verion 0.1.3.  C     ==================================================================
29  c  C     SUBROUTINE cal_ConvDate
30  c              21-Sep-2003: fixed check_sign logic to work with  C     ==================================================================
 c              negative intervals (menemenlis@jpl.nasa.gov)  
 c  
 c     ==================================================================  
 c     SUBROUTINE cal_ConvDate  
 c     ==================================================================  
31    
32        implicit none        IMPLICIT NONE
   
 c     == global variables ==  
33    
34    C     == global variables ==
35    #include "EEPARAMS.h"
36  #include "cal.h"  #include "cal.h"
37    
38  c     == routine arguments ==  C     == routine arguments ==
39          INTEGER date(4)
40        integer date(4)        INTEGER myThid
41        integer mythid  
42    C     == local variables ==
43  c     == local variables ==        INTEGER yy
44          INTEGER mm
45        integer yy        INTEGER dd
46        integer mm        INTEGER ss
47        integer dd        INTEGER lp
48        integer ss        INTEGER wd
49        integer lp        INTEGER fac
50        integer wd        INTEGER date_1
51        integer fac        INTEGER date_2
52        integer date_1        INTEGER ierr
53        integer date_2        INTEGER check_sign
54        integer ierr        CHARACTER*(MAX_LEN_MBUF) msgBuf
55        integer check_sign  C     == end of interface ==
56    
57  c     == end of interface ==        IF ( cal_setStatus .LT. 1 ) THEN
58            WRITE( msgBuf,'(2A,4I9)') 'CAL_CONVDATE: ',
59         &       'date=',date(1),date(2),date(3),date(4)
60            CALL PRINT_ERROR( msgBuf, myThid )
61            WRITE( msgBuf,'(2A,I2,A)') 'CAL_CONVDATE: ',
62         &    'called too early (cal_setStatus=',cal_setStatus,' )'
63            CALL PRINT_ERROR( msgBuf, myThid )
64            STOP 'ABNORMAL END: S/R CAL_CONVDATE'
65          ENDIF
66    
67        fac = 1        fac = 1
68    
69  c     Check the sign of the date.  C     Check the sign of the date.
70    
71        check_sign = 1        check_sign = 1
72        if ( ( (date(1).lt.0) .and. date(2).gt.0 ) .or.        if ( ( (date(1).lt.0) .and. date(2).gt.0 ) .or.
# Line 93  c     Check the sign of the date. Line 95  c     Check the sign of the date.
95        else        else
96    
97          ierr = 901          ierr = 901
98          call cal_PrintError( ierr, mythid )          call cal_PrintError( ierr, myThid )
99          stop ' stopped in cal_ConvDate.'          stop ' stopped in cal_ConvDate.'
100    
101        endif        endif
102    
103  c     Decompose the entries.  C     Decompose the entries.
104        if (date(4) .ne. -1) then        if (date(4) .ne. -1) then
105          yy = date_1/10000          yy = date_1/10000
106          mm = mod(date_1/100,100)          mm = mod(date_1/100,100)
# Line 112  c     Decompose the entries. Line 114  c     Decompose the entries.
114       &     mod(date_2/100,100)*secondsperminute +       &     mod(date_2/100,100)*secondsperminute +
115       &     date_2/10000*secondsperhour       &     date_2/10000*secondsperhour
116    
117  c     Include the sign.  C     Include the sign.
118        yy = fac*yy        yy = fac*yy
119        mm = fac*mm        mm = fac*mm
120        dd = fac*dd        dd = fac*dd
# Line 121  c     Include the sign. Line 123  c     Include the sign.
123        lp = date(3)        lp = date(3)
124        wd = date(4)        wd = date(4)
125    
126        return        RETURN
127        end        END
128    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22