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

Contents of /MITgcm/pkg/cal/cal_timepassed.F

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

Revision 1.1 - (show annotations) (download)
Mon May 14 22:07:27 2001 UTC (23 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint44e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, release1_p13_pre, checkpoint50c_post, checkpoint46f_post, checkpoint48e_post, checkpoint50c_pre, checkpoint44f_post, checkpoint46b_post, checkpoint43a-release1mods, ecco_c50_e32, ecco_c50_e33, ecco_c50_e30, ecco_c50_e31, release1_p13, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint48i_post, checkpoint40pre9, checkpoint40pre8, checkpoint46l_pre, chkpt44d_post, checkpoint51, checkpoint50, release1_p8, release1_p9, checkpoint50d_post, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint50b_pre, checkpoint44e_pre, checkpoint51f_post, release1_b1, ecco_c51_e34d, ecco_c51_e34e, ecco_c51_e34f, ecco_c51_e34g, ecco_c51_e34a, ecco_c51_e34b, ecco_c51_e34c, checkpoint48b_post, checkpoint43, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, release1_chkpt44d_post, checkpoint47a_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint47d_post, icebear5, icebear4, icebear3, icebear2, checkpoint46d_pre, checkpoint40pre2, checkpoint48d_post, release1-branch_tutorials, checkpoint48f_post, checkpoint45d_post, checkpoint46j_pre, chkpt44a_post, checkpoint44h_pre, checkpoint48h_post, checkpoint40pre4, ecco_c50_e29, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, ecco_c50_e28, chkpt44c_pre, checkpoint48a_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint47j_post, ecco_c50_e33a, branch-exfmods-tag, checkpoint44g_post, branchpoint-genmake2, checkpoint46e_pre, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, release1-branch-end, release1_final_v1, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint46, checkpoint47b_post, checkpoint44b_post, ecco_c51_e34, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, ecco_ice2, ecco_ice1, checkpoint44h_post, checkpoint46g_post, release1_p12_pre, checkpoint39, ecco_c44_e22, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, ecco_c44_e25, checkpoint51i_pre, checkpoint40pre5, checkpoint47f_post, checkpoint50e_post, chkpt44a_pre, checkpoint46i_post, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, checkpoint46c_post, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, checkpoint50d_pre, checkpoint46e_post, release1_beta1, checkpoint51e_post, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint46h_post, checkpoint51f_pre, chkpt44c_post, checkpoint48g_post, checkpoint47h_post, checkpoint44f_pre, checkpoint51g_post, checkpoint46d_post, checkpoint50b_post, release1-branch_branchpoint, checkpoint51a_post
Branch point for: c24_e25_ice, branch-exfmods-curt, release1_final, release1-branch, branch-genmake2, release1, ecco-branch, release1_50yr, icebear, release1_coupled 
Added calendar package.
Not currently supported by mitgcm, i.e. disabled by default.
1 C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_timepassed.F,v 1.4 2001/02/02 16:57:22 heimbach Exp $
2
3 #include "CAL_CPPOPTIONS.h"
4
5 subroutine cal_TimePassed(
6 I initialdate,
7 I finaldate,
8 O numdays,
9 I mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE cal_TimePassed
14 c ==================================================================
15 c
16 c o Calculate the time that passed between initialdate and
17 c finaldate.
18 c
19 c started: Christian Eckert eckert@mit.edu 30-Jun-1999
20 c
21 c changed: Christian Eckert eckert@mit.edu 29-Dec-1999
22 c
23 c - restructured the original version in order to have a
24 c better interface to the MITgcmUV.
25 c
26 c Christian Eckert eckert@mit.edu 03-Feb-2000
27 c
28 c - Introduced new routine and function names, cal_<NAME>,
29 c for verion 0.1.3.
30 c
31 c ==================================================================
32 c SUBROUTINE cal_TimePassed
33 c ==================================================================
34
35 implicit none
36
37 c == global variables ==
38
39 #include "cal.h"
40
41 c == routine arguments ==
42
43 integer initialdate(4)
44 integer finaldate(4)
45 integer numdays(4)
46 integer mythid
47
48 c == local variables ==
49
50 integer yi,yf
51 integer mi,mf
52 integer di,df
53 integer si,sf
54 integer li,lf
55 integer wi,wf
56 integer cdi,cdf
57 integer csi,csf
58 integer ndays
59 integer nsecs
60 integer hhmmss
61 integer imon
62 integer iyr
63 integer ierr
64
65 logical swap
66 logical caldates
67 logical nothingtodo
68
69 c == external ==
70
71 integer cal_IsLeap
72 external cal_IsLeap
73
74 c == end of interface ==
75
76 nothingtodo = .false.
77
78 c Initialise output.
79 numdays(1) = 0
80 numdays(2) = 0
81 numdays(3) = 0
82 numdays(4) = -1
83
84 if ((initialdate(4) .gt. 0) .eqv.
85 & ( finaldate(4) .gt. 0)) then
86
87 caldates = (initialdate(4) .gt. 0) .and.
88 & ( finaldate(4) .gt. 0)
89
90 c Check relation between initial and final dates.
91 if (initialdate(1) .eq. finaldate(1)) then
92 if (initialdate(2) .eq. finaldate(2)) then
93 nothingtodo = .true.
94 else if (initialdate(2) .gt. finaldate(2)) then
95 swap = .true.
96 else
97 swap = .false.
98 endif
99 else if (initialdate(1) .gt. finaldate(1)) then
100 swap = .true.
101 else
102 swap = .false.
103 endif
104
105 if (.not. nothingtodo) then
106
107 if (swap) then
108 call cal_ConvDate( finaldate,yi,mi,di,si,li,wi,mythid )
109 call cal_ConvDate( initialdate,yf,mf,df,sf,lf,wf,mythid )
110 else
111 call cal_ConvDate( initialdate,yi,mi,di,si,li,wi,mythid )
112 call cal_ConvDate( finaldate,yf,mf,df,sf,lf,wf,mythid )
113 endif
114
115 c Determine the time interval.
116 if (.not. caldates) then
117 ndays = df - di
118 nsecs = sf - si
119 if (nsecs .lt. 0) then
120 nsecs = nsecs + secondsperday
121 ndays = ndays - 1
122 endif
123 ndays = ndays + nsecs/secondsperday
124 nsecs = mod(nsecs,secondsperday)
125 else
126 si = si + (di-1)*secondsperday
127 sf = sf + (df-1)*secondsperday
128 cdi = 0
129 do imon = 1,mod(mi-1,12)
130 cdi = cdi + ndaymonth(imon,li)
131 enddo
132 csi = si
133 cdf = 0
134 do imon = 1,mod(mf-1,12)
135 cdf = cdf + ndaymonth(imon,lf)
136 enddo
137 csf = sf
138
139 if (yi .eq. yf) then
140 ndays = (cdf + csf/secondsperday) -
141 & (cdi + csi/secondsperday)
142 nsecs = (csf - (csf/secondsperday)*secondsperday) -
143 & (csi - (csi/secondsperday)*secondsperday)
144 if (nsecs .lt. 0) then
145 nsecs = nsecs + secondsperday
146 ndays = ndays - 1
147 endif
148 else
149 ndays = (ndaysnoleap - 1) + cal_IsLeap( yi, mythid ) -
150 & cdi - ndaymonth(mi,li)
151 do iyr = yi+1,yf-1
152 ndays = ndays + (ndaysnoleap - 1) +
153 & cal_IsLeap( iyr, mythid )
154 enddo
155 ndays = ndays + cdf
156 csi = ndaymonth(mi,li)*secondsperday - csi
157 nsecs = csi + csf
158 endif
159 endif
160
161 c Convert to calendar format.
162 numdays(1) = ndays + nsecs/secondsperday
163 nsecs = mod(nsecs,secondsperday)
164 hhmmss = nsecs/secondsperminute
165 numdays(2) = hhmmss/minutesperhour*10000 +
166 & mod(hhmmss,minutesperhour)*100 +
167 & mod(nsecs,secondsperminute)
168 if (swap) then
169 numdays(1) = -numdays(1)
170 numdays(2) = -numdays(2)
171 endif
172
173 else
174 c Dates are equal.
175 endif
176
177 else
178
179 ierr = 501
180 call cal_PrintError( ierr, mythid )
181 stop ' stopped in cal_TimePassed'
182
183 endif
184
185 return
186 end
187
  ViewVC Help
Powered by ViewVC 1.1.22