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

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

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

revision 1.2 by edhill, Thu Oct 9 04:19:19 2003 UTC revision 1.3 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_SubDates(        SUBROUTINE CAL_SUBDATES(
7       I                         finaldate,       I                         finaldate,
8       I                         initialdate,       I                         initialdate,
9       O                         diffdate,       O                         diffdate,
10       I                         mythid       I                         myThid )
      &                       )  
11    
12  c     ==================================================================  C     ==================================================================
13  c     SUBROUTINE cal_SubDates  C     SUBROUTINE cal_SubDates
14  c     ==================================================================  C     ==================================================================
15  c  C
16  c     o Subtract two dates. In case calendar dates are given finaldate  C     o Subtract two dates. In case calendar dates are given finaldate
17  c       must be after initialdate.  C       must be after initialdate.
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_SubDates
29  c                for verion 0.1.3.  C     ==================================================================
 c  
 c     ==================================================================  
 c     SUBROUTINE cal_SubDates  
 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 finaldate(4)
39        integer finaldate(4)        INTEGER initialdate(4)
40        integer initialdate(4)        INTEGER diffdate(4)
41        integer diffdate(4)        INTEGER myThid
42        integer mythid  
43    C     == local variables ==
44  c     == local variables ==        INTEGER workdate(4)
45          INTEGER ierr
46        integer workdate(4)        CHARACTER*(MAX_LEN_MBUF) msgBuf
47        integer ierr  
48    C     == end of interface ==
49  c     == end of interface ==  
50          IF ( cal_setStatus .LT. 1 ) THEN
51            WRITE( msgBuf,'(2A,4I9)') 'CAL_SUBDATES: ', 'finaldate=',
52         &    finaldate(1),finaldate(2),finaldate(3),finaldate(4)
53            CALL PRINT_ERROR( msgBuf, myThid )
54            WRITE( msgBuf,'(2A,4I9)') 'CAL_SUBDATES: ', 'initialdate=',
55         &    initialdate(1),initialdate(2),initialdate(3),initialdate(4)
56            CALL PRINT_ERROR( msgBuf, myThid )
57            WRITE( msgBuf,'(2A,I2,A)') 'CAL_SUBDATES: ',
58         &    'called too early (cal_setStatus=',cal_setStatus,' )'
59            CALL PRINT_ERROR( msgBuf, myThid )
60            STOP 'ABNORMAL END: S/R CAL_SUBDATES'
61          ENDIF
62    
63        if ((initialdate(4) .gt. 0) .eqv.        if ((initialdate(4) .gt. 0) .eqv.
64       &    (  finaldate(4) .gt. 0)) then       &    (  finaldate(4) .gt. 0)) then
65    
   
66          if (initialdate(4) .eq. -1) then          if (initialdate(4) .eq. -1) then
67  c         The time interval is subtracted.  C         The time interval is subtracted.
68            workdate(1) = -initialdate(1)            workdate(1) = -initialdate(1)
69            workdate(2) = -initialdate(2)            workdate(2) = -initialdate(2)
70            workdate(3) =  0            workdate(3) =  0
71            workdate(4) = -1            workdate(4) = -1
72            call cal_AddTime( finaldate, workdate, diffdate, mythid )            call cal_AddTime( finaldate, workdate, diffdate, myThid )
73          else          else
74  c         The time interval between initial and final date is calculated.  C         The time interval between initial and final date is calculated.
75            call cal_TimePassed(            call cal_TimePassed(
76       &          initialdate, finaldate, diffdate, mythid )       &          initialdate, finaldate, diffdate, myThid )
77          endif          endif
78        else        else
79    
80          ierr = 801          ierr = 801
81          call cal_PrintError( ierr, mythid )          call cal_PrintError( ierr, myThid )
82          stop ' stopped in cal_SubDates.'          stop ' stopped in cal_SubDates.'
83    
84        endif        endif
85    
86   100  continue        RETURN
87          END
       return  
       end  
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22