Loading...
Searching...
No Matches
dccaldatedifference.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

real(dp) function dccaldatedifference1 (start_date, end_date, cal)

Function/Subroutine Documentation

◆ dccaldatedifference1()

real(dp) function dccaldatedifference1 ( type(dc_cal_date), intent(in) start_date,
type(dc_cal_date), intent(in) end_date,
type(dc_cal), intent(in), optional, target cal )

Definition at line 14 of file dccaldatedifference.f90.

15 !
16 ! 日時差を算出します.
17 !
18 ! 省略可能引数 *cal* が省略された場合には, 日時差の算出に
19 ! dc_calendar 内部で保持される暦が用いられます.
20 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
21 !
22 ! Evaluate difference of date.
23 !
24 ! If an optional argument *cal* is omitted,
25 ! information of calendar that is stored in the "dc_calendar"
26 ! is used for evaluation of difference of date.
27 ! If *cal* is not omitted, information of the variable is used.
28 !
29
38 use dc_message, only: messagenotify
39 use dc_trace, only: beginsub, endsub
40 use dc_types, only: dp, token, string
41 implicit none
42 real(DP):: sec
43 ! *start_date* と *end_date* との差 (秒数).
44 ! Difference (seconds) between *start_date* and *end_date*.
45 type(DC_CAL_DATE), intent(in):: start_date
46 ! 起点となる日時.
47 ! Date of origin.
48 type(DC_CAL_DATE), intent(in):: end_date
49 ! 終点となる日時.
50 ! Date of terminus.
51 type(DC_CAL), intent(in), optional, target:: cal
52 ! 暦情報を収めたオブジェクト.
53 !
54 ! An object that stores information of
55 ! calendar.
56
57 ! 作業変数
58 ! Work variables
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 ! Associate pointer of an object
70 !
71 if ( present( cal ) ) then
72 calp => cal
73 else
74 calp => default_cal
75 if ( .not. calp % initialized ) call default_cal_set
76 end if
77
78 ! 初期設定のチェック
79 ! Check initialization
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 ! Convert into days
104 !
105 select case( calp % cal_type )
106 case( cal_julian )
107
108 day_in_4years = 1461
109
110 ! 年が負の場合,400 年単位で引き算し下駄を履かせる
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 ! start_date の日への変換
120 ! Convert start_date into days
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 ! 年が負の場合,400 年単位で引き算し下駄を履かせる
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 ! end_date の日への変換
150 ! Convert end_date into days
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
170 case( cal_gregorian )
171
172 day_in_400years = 146097
173
174 ! 年が負の場合,400 年単位で引き算し下駄を履かせる
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 ! start_date の日への変換
184 ! Convert start_date into days
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 ! 年が負の場合,400 年単位で引き算し下駄を履かせる
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 ! end_date の日への変換
240 ! Convert end_date into days
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 ! start_date の日への変換
288 ! Convert start_date into days
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 ! end_date の日への変換
297 ! Convert end_date into days
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 ! start_date の秒への変換
307 ! Convert start_date into seconds
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 ! end_date の秒への変換
319 ! Convert end_date into seconds
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 ! Calculate difference
332 !
333 sec = end_sec - start_sec
334
335 ! 終了処理, 例外処理
336 ! Termination and Exception handling
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)
Definition dc_error.f90:830
integer, parameter, public dc_ebadunit
Definition dc_error.f90:559
integer, parameter, public dc_enotinit
Definition dc_error.f90:557
integer, parameter, public dc_noerr
Definition dc_error.f90:509
Provides kind type parameter values.
Definition dc_types.f90:49
integer, parameter, public token
Character length for word, token
Definition dc_types.f90:109
integer, parameter, public string
Character length for string
Definition dc_types.f90:118
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:83

References dc_calendar_types::cal_360day, dc_calendar_types::cal_cyclic, dc_calendar_types::cal_gregorian, dc_calendar_types::cal_julian, dc_calendar_types::cal_noleap, dc_calendar_types::cal_user_defined, dc_error::dc_ebadunit, dc_error::dc_enotinit, dc_error::dc_noerr, dc_calendar_internal::dccaldate_str2usym(), dc_calendar_internal::dccaltype_str(), dc_calendar_internal::default_cal, dc_calendar_internal::default_cal_set(), dc_types::dp, dc_error::storeerror(), dc_types::string, dc_types::token, dc_calendar_types::unit_symbol_day, dc_calendar_types::unit_symbol_hour, dc_calendar_types::unit_symbol_min, dc_calendar_types::unit_symbol_month, dc_calendar_types::unit_symbol_sec, and dc_calendar_types::unit_symbol_year.

Here is the call graph for this function: