15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
38 use dc_message, only: messagenotify
39 use dc_trace, only: beginsub, endsub
41 implicit none
42 real(DP):: sec
43
44
45 type(DC_CAL_DATE), intent(in):: start_date
46
47
48 type(DC_CAL_DATE), intent(in):: end_date
49
50
51 type(DC_CAL), intent(in), optional, target:: cal
52
53
54
55
56
57
58
59
60 type(DC_CAL), pointer:: calp =>null()
61 real(DP):: start_year, start_day, start_sec, start_neg_offset_day
62 real(DP):: end_year, end_day, end_sec, end_neg_offset_day
63 integer:: day_in_4years, day_in_400years
64 integer:: start_year_int, end_year_int
65 integer:: i, j
66 character(*), parameter:: subname = 'DCCalDateDifference1'
67continue
68
69
70
71 if ( present( cal ) ) then
72 calp => cal
73 else
76 end if
77
78
79
80
81 if ( .not. calp % initialized ) then
82 sec = 0.0_dp
83 return
84 end if
85
86 if ( .not. start_date % initialized ) then
87 sec = 0.0_dp
88 return
89 end if
90
91 if ( .not. end_date % initialized ) then
92 sec = 0.0_dp
93 return
94 end if
95
96 start_neg_offset_day = 0
97 end_neg_offset_day = 0
98
99 start_year_int = start_date % year
100 end_year_int = end_date % year
101
102
103
104
105 select case( calp % cal_type )
107
108 day_in_4years = 1461
109
110
111
112 do while ( start_year_int < 1 )
113 start_neg_offset_day = start_neg_offset_day &
114 & + day_in_4years * 100
115 start_year_int = start_year_int &
116 & + 400
117 end do
118
119
120
121
122 if ( ( start_year_int - 1 ) > 4 ) then
123 start_day = int( ( start_year_int - 1 ) / 4 ) * day_in_4years
124 start_year = mod( start_year_int - 1, 4 ) + 1
125 else
126 start_day = 0
127 start_year = start_year_int
128 end if
129
130 start_day = start_day + ( start_year - 1 ) * sum( calp % day_in_month(:) )
131 do i = 1, start_date % month - 1
132 if ( start_year == 4 .and. i == 2 ) then
133 start_day = start_day + 29
134 else
135 start_day = start_day + calp % day_in_month(i)
136 end if
137 end do
138 start_day = start_day + start_date % day
139
140
141
142 do while ( end_year_int < 1 )
143 end_neg_offset_day = end_neg_offset_day &
144 & + day_in_4years * 100
145 end_year_int = end_year_int &
146 & + 400
147 end do
148
149
150
151
152 if ( ( end_year_int - 1 ) > 4 ) then
153 end_day = int( ( end_year_int - 1 ) / 4 ) * day_in_4years
154 end_year = mod( end_year_int - 1, 4 ) + 1
155 else
156 end_day = 0
157 end_year = end_year_int
158 end if
159
160 end_day = end_day + ( end_year - 1 ) * sum( calp % day_in_month(:) )
161 do i = 1, end_date % month - 1
162 if ( end_year == 4 .and. i == 2 ) then
163 end_day = end_day + 29
164 else
165 end_day = end_day + calp % day_in_month(i)
166 end if
167 end do
168 end_day = end_day + end_date % day
169
171
172 day_in_400years = 146097
173
174
175
176 do while ( start_year_int < 1 )
177 start_neg_offset_day = start_neg_offset_day &
178 & + day_in_400years
179 start_year_int = start_year_int &
180 & + 400
181 end do
182
183
184
185
186 if ( ( start_year_int - 1 ) > 400 ) then
187 start_day = int( ( start_year_int - 1 ) / 400 ) * day_in_400years
188 start_year = mod( start_year_int - 1, 400 ) + 1
189 else
190 start_day = 0
191 start_year = start_year_int
192 end if
193
194 do j = 1, int( start_year - 1 )
195 do i = 1, calp % month_in_year
196 if ( i == 2 ) then
197 if ( mod( j, 400 ) == 0 ) then
198 start_day = start_day + 29
199 elseif ( mod( j, 100 ) == 0 ) then
200 start_day = start_day + 28
201 elseif ( mod( j, 4 ) == 0 ) then
202 start_day = start_day + 29
203 else
204 start_day = start_day + 28
205 end if
206 else
207 start_day = start_day + calp % day_in_month(i)
208 end if
209 end do
210 end do
211
212 do i = 1, start_date % month - 1
213 if ( i == 2 ) then
214 if ( mod( start_year, 400.0_dp ) == 0 ) then
215 start_day = start_day + 29
216 elseif ( mod( start_year, 100.0_dp ) == 0 ) then
217 start_day = start_day + 28
218 elseif ( mod( start_year, 4.0_dp ) == 0 ) then
219 start_day = start_day + 29
220 else
221 start_day = start_day + 28
222 end if
223 else
224 start_day = start_day + calp % day_in_month(i)
225 end if
226 end do
227
228 start_day = start_day + start_date % day
229
230
231
232 do while ( end_year_int < 1 )
233 end_neg_offset_day = end_neg_offset_day &
234 & + day_in_400years
235 end_year_int = end_year_int &
236 & + 400
237 end do
238
239
240
241
242 if ( ( end_year_int - 1 ) > 400 ) then
243 end_day = int( ( end_year_int - 1 ) / 400 ) * day_in_400years
244 end_year = mod( end_year_int - 1, 400 ) + 1
245 else
246 end_day = 0
247 end_year = end_year_int
248 end if
249
250 do j = 1, int( end_year - 1 )
251 do i = 1, calp % month_in_year
252 if ( i == 2 ) then
253 if ( mod( j, 400 ) == 0 ) then
254 end_day = end_day + 29
255 elseif ( mod( j, 100 ) == 0 ) then
256 end_day = end_day + 28
257 elseif ( mod( j, 4 ) == 0 ) then
258 end_day = end_day + 29
259 else
260 end_day = end_day + 28
261 end if
262 else
263 end_day = end_day + calp % day_in_month(i)
264 end if
265 end do
266 end do
267
268 do i = 1, end_date % month - 1
269 if ( i == 2 ) then
270 if ( mod( end_year, 400.0_dp ) == 0 ) then
271 end_day = end_day + 29
272 elseif ( mod( end_year, 100.0_dp ) == 0 ) then
273 end_day = end_day + 28
274 elseif ( mod( end_year, 4.0_dp ) == 0 ) then
275 end_day = end_day + 29
276 else
277 end_day = end_day + 28
278 end if
279 else
280 end_day = end_day + calp % day_in_month(i)
281 end if
282 end do
283
284 end_day = end_day + end_date % day
285
286 case default
287
288
289
290 start_day = ( start_year_int - 1 ) * sum( calp % day_in_month(:) )
291 do i = 1, start_date % month - 1
292 start_day = start_day + calp % day_in_month(i)
293 end do
294 start_day = start_day + start_date % day
295
296
297
298
299 end_day = ( end_year_int - 1 ) * sum( calp % day_in_month(:) )
300 do i = 1, end_date % month - 1
301 end_day = end_day + calp % day_in_month(i)
302 end do
303 end_day = end_day + end_date % day
304 end select
305
306
307
308
309 start_sec = ( start_day - 1 - start_neg_offset_day ) &
310 & * calp % hour_in_day &
311 & * calp % min_in_hour &
312 & * calp % sec_in_min &
313 & + start_date % hour * calp % min_in_hour &
314 & * calp % sec_in_min &
315 & + start_date % min * calp % sec_in_min &
316 & + start_date % sec
317
318
319
320
321 end_sec = ( end_day - 1 - end_neg_offset_day ) &
322 & * calp % hour_in_day &
323 & * calp % min_in_hour &
324 & * calp % sec_in_min &
325 & + end_date % hour * calp % min_in_hour &
326 & * calp % sec_in_min &
327 & + end_date % min * calp % sec_in_min &
328 & + end_date % sec
329
330
331
332
333 sec = end_sec - start_sec
334
335
336
337
338999 continue
339 nullify( calp )
type(dc_cal), target, save, public default_cal
character(token) function, public dccaltype_str(cal_type)
subroutine, public default_cal_set
integer function, public dccaldate_str2usym(str)
integer, parameter, public cal_user_defined
integer, parameter, public cal_julian
integer, parameter, public unit_symbol_sec
integer, parameter, public cal_gregorian
integer, parameter, public unit_symbol_month
integer, parameter, public unit_symbol_year
integer, parameter, public unit_symbol_hour
integer, parameter, public unit_symbol_day
integer, parameter, public unit_symbol_min
integer, parameter, public cal_360day
integer, parameter, public cal_noleap
integer, parameter, public cal_cyclic
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_ebadunit
integer, parameter, public dc_enotinit
integer, parameter, public dc_noerr
Provides kind type parameter values.
integer, parameter, public token
Character length for word, token
integer, parameter, public string
Character length for string
integer, parameter, public dp
Double Precision Real number