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
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
integer, parameter, public dp
倍精度実数型変数
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ