Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief This file contains the implementations of the tests of module [pm_dateTime](@ref pm_dateTime).
18 : !>
19 : !> \fintest
20 : !>
21 : !> \author
22 : !> \AmirShahmoradi, March 22, 2012, 2:21 PM, National Institute for Fusion Studies, The University of Texas at Austin
23 :
24 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
25 :
26 : submodule (test_pm_dateTime) routines
27 :
28 : use pm_val2str, only: getStr
29 : implicit none
30 :
31 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
32 :
33 : contains
34 :
35 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36 :
37 1 : module procedure test_constructDateTimeInt
38 :
39 : type(dateTimeInt_type) :: DTI
40 : integer(IK) :: i, values_ref(8)
41 : integer(IK), allocatable :: Values(:)
42 1 : call date_and_time(values = values_ref)
43 : assertion = .true._LK
44 :
45 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
46 :
47 1 : values_ref = [integer(IK) :: 1, 1, 1, 0, 0, 0, 0, 0]
48 1 : assertion = assertion .and. logical(DTI%year == values_ref(1), LK)
49 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `year` component.", int(__LINE__, IK))
50 1 : assertion = assertion .and. logical(DTI%month == values_ref(2), LK)
51 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `month` component.", int(__LINE__, IK))
52 1 : assertion = assertion .and. logical(DTI%day == values_ref(3), LK)
53 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `day` component.", int(__LINE__, IK))
54 1 : assertion = assertion .and. logical(DTI%zone == values_ref(4), LK)
55 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `zone` component.", int(__LINE__, IK))
56 1 : assertion = assertion .and. logical(DTI%hour == values_ref(5), LK)
57 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `hour` component.", int(__LINE__, IK))
58 1 : assertion = assertion .and. logical(DTI%minute == values_ref(6), LK)
59 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `minute` component.", int(__LINE__, IK))
60 1 : assertion = assertion .and. logical(DTI%second == values_ref(7), LK)
61 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `second` component.", int(__LINE__, IK))
62 1 : assertion = assertion .and. logical(DTI%millisecond == values_ref(8), LK)
63 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor with no input arguments must correctly initialize the `millisecond` component.", int(__LINE__, IK))
64 2 : Values = DTI%getValues()
65 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The size of the returned vector by `getValues()` method must be 8. size(DTI%getValues()) = "//getStr(size(DTI%getValues())), int(__LINE__, IK))
66 9 : do i = 1, size(values_ref)
67 8 : assertion = assertion .and. logical(Values(i) == values_ref(i), LK)
68 33 : call test%assert(assertion, SK_"@dateTimeInt_type(): The type constructor must correctly extract the `i`th component value. i, Values(i), values_ref(i)"//getStr([i, Values(i), values_ref(i)]), int(__LINE__, IK))
69 : end do
70 :
71 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
72 :
73 : DTI = dateTimeInt_type ( year = values_ref(1) &
74 : , month = values_ref(2) &
75 : , day = values_ref(3) &
76 : , zone = values_ref(4) &
77 : , hour = values_ref(5) &
78 : , minute = values_ref(6) &
79 : , second = values_ref(7) &
80 : , millisecond = values_ref(8) &
81 1 : )
82 1 : assertion = assertion .and. logical(DTI%year == values_ref(1), LK)
83 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `year` component.", int(__LINE__, IK))
84 1 : assertion = assertion .and. logical(DTI%month == values_ref(2), LK)
85 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `month` component.", int(__LINE__, IK))
86 1 : assertion = assertion .and. logical(DTI%day == values_ref(3), LK)
87 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `day` component.", int(__LINE__, IK))
88 1 : assertion = assertion .and. logical(DTI%zone == values_ref(4), LK)
89 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `zone` component.", int(__LINE__, IK))
90 1 : assertion = assertion .and. logical(DTI%hour == values_ref(5), LK)
91 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `hour` component.", int(__LINE__, IK))
92 1 : assertion = assertion .and. logical(DTI%minute == values_ref(6), LK)
93 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `minute` component.", int(__LINE__, IK))
94 1 : assertion = assertion .and. logical(DTI%second == values_ref(7), LK)
95 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `second` component.", int(__LINE__, IK))
96 1 : assertion = assertion .and. logical(DTI%millisecond == values_ref(8), LK)
97 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `millisecond` component.", int(__LINE__, IK))
98 1 : Values = DTI%getValues()
99 1 : assertion = assertion .and. logical(size(Values) == 8, LK)
100 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The size of the returned vector by `getValues()` method must be 8. size(DTI%getValues()) = "//getStr(size(DTI%getValues())), int(__LINE__, IK))
101 9 : do i = 1, size(values_ref)
102 8 : assertion = assertion .and. logical(Values(i) == values_ref(i), LK)
103 33 : call test%assert(assertion, SK_"@dateTimeInt_type(): The type constructor must correctly extract the `i`th component value. i, Values(i), values_ref(i)"//getStr([i, Values(i), values_ref(i)]), int(__LINE__, IK))
104 : end do
105 :
106 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107 :
108 1 : do i = 1, 10
109 1 : values_ref = getDateTime()
110 1 : DTI = dateTimeInt_type()
111 : if (DTI%year == values_ref(1) .and. & ! LCOV_EXCL_LINE
112 : DTI%month == values_ref(2) .and. & ! LCOV_EXCL_LINE
113 : DTI%day == values_ref(3) .and. & ! LCOV_EXCL_LINE
114 : DTI%zone == values_ref(4) .and. & ! LCOV_EXCL_LINE
115 : DTI%hour == values_ref(5) .and. & ! LCOV_EXCL_LINE
116 : DTI%minute == values_ref(6) .and. & ! LCOV_EXCL_LINE
117 1 : DTI%second == values_ref(7)) exit
118 : end do
119 1 : assertion = assertion .and. logical(DTI%year == values_ref(1), LK)
120 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `year` component.", int(__LINE__, IK))
121 1 : assertion = assertion .and. logical(DTI%month == values_ref(2), LK)
122 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `month` component.", int(__LINE__, IK))
123 1 : assertion = assertion .and. logical(DTI%day == values_ref(3), LK)
124 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `day` component.", int(__LINE__, IK))
125 1 : assertion = assertion .and. logical(DTI%zone == values_ref(4), LK)
126 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `zone` component.", int(__LINE__, IK))
127 1 : assertion = assertion .and. logical(DTI%hour == values_ref(5), LK)
128 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `hour` component.", int(__LINE__, IK))
129 1 : assertion = assertion .and. logical(DTI%minute == values_ref(6), LK)
130 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `minute` component.", int(__LINE__, IK))
131 1 : assertion = assertion .and. logical(DTI%second == values_ref(7), LK)
132 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `second` component.", int(__LINE__, IK))
133 :
134 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
135 :
136 1 : end procedure
137 :
138 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
139 :
140 1 : module procedure test_constructDateTimeStr
141 :
142 : use pm_container, only: strc => css_type
143 : type(dateTimeStr_type) :: DTS
144 1 : type(strc), allocatable :: values_ref(:)
145 : character( 8, SK) :: date
146 : character(10, SK) :: time
147 : character( 5, SK) :: zone
148 : integer :: i
149 1 : assertion = .true._LK
150 :
151 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
152 :
153 17 : values_ref = [strc(SK_"0001"), strc(SK_"01"), strc(SK_"01"), strc(SK_"+0000"), strc(SK_"00"), strc(SK_"00"), strc(SK_"00"), strc(SK_"000")]
154 1 : assertion = assertion .and. logical(DTS%year == values_ref(1)%val, LK)
155 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `year` component.", int(__LINE__, IK))
156 1 : assertion = assertion .and. logical(DTS%month == values_ref(2)%val, LK)
157 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `month` component.", int(__LINE__, IK))
158 1 : assertion = assertion .and. logical(DTS%day == values_ref(3)%val, LK)
159 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `day` component.", int(__LINE__, IK))
160 1 : assertion = assertion .and. logical(DTS%zone == values_ref(4)%val, LK)
161 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `zone` component.", int(__LINE__, IK))
162 1 : assertion = assertion .and. logical(DTS%hour == values_ref(5)%val, LK)
163 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `hour` component.", int(__LINE__, IK))
164 1 : assertion = assertion .and. logical(DTS%minute == values_ref(6)%val, LK)
165 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `minute` component.", int(__LINE__, IK))
166 1 : assertion = assertion .and. logical(DTS%second == values_ref(7)%val, LK)
167 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `second` component.", int(__LINE__, IK))
168 1 : assertion = assertion .and. logical(DTS%millisecond == values_ref(8)%val, LK)
169 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor with no input arguments must correctly initialize the `millisecond` component.", int(__LINE__, IK))
170 :
171 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
172 :
173 1 : call date_and_time(date = date, zone = zone, time = time)
174 1 : values_ref(1)%val = date(1:4)
175 1 : values_ref(2)%val = date(5:6)
176 1 : values_ref(3)%val = date(7:8)
177 1 : values_ref(4)%val = zone
178 1 : values_ref(5)%val = time(1:2)
179 1 : values_ref(6)%val = time(3:4)
180 1 : values_ref(7)%val = time(5:6)
181 1 : values_ref(8)%val = time(8:10)
182 : DTS = dateTimeStr_type ( year = values_ref(1)%val &
183 : , month = values_ref(2)%val &
184 : , day = values_ref(3)%val &
185 : , zone = values_ref(4)%val &
186 : , hour = values_ref(5)%val &
187 : , minute = values_ref(6)%val &
188 : , second = values_ref(7)%val &
189 : , millisecond = values_ref(8)%val &
190 1 : )
191 1 : assertion = assertion .and. logical(DTS%year == values_ref(1)%val, LK)
192 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `year` component.", int(__LINE__, IK))
193 1 : assertion = assertion .and. logical(DTS%month == values_ref(2)%val, LK)
194 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `month` component.", int(__LINE__, IK))
195 1 : assertion = assertion .and. logical(DTS%day == values_ref(3)%val, LK)
196 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `day` component.", int(__LINE__, IK))
197 1 : assertion = assertion .and. logical(DTS%zone == values_ref(4)%val, LK)
198 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `zone` component.", int(__LINE__, IK))
199 1 : assertion = assertion .and. logical(DTS%hour == values_ref(5)%val, LK)
200 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `hour` component.", int(__LINE__, IK))
201 1 : assertion = assertion .and. logical(DTS%minute == values_ref(6)%val, LK)
202 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `minute` component.", int(__LINE__, IK))
203 1 : assertion = assertion .and. logical(DTS%second == values_ref(7)%val, LK)
204 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `second` component.", int(__LINE__, IK))
205 1 : assertion = assertion .and. logical(DTS%millisecond == values_ref(8)%val, LK)
206 1 : call test%assert(assertion, SK_"@dateTimeStr_type(): The default constructor must correctly assign the `millisecond` component.", int(__LINE__, IK))
207 :
208 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
209 :
210 1 : do i = 1, 10
211 1 : call date_and_time(date = date, zone = zone, time = time)
212 1 : DTS = dateTimeStr_type()
213 1 : values_ref(1)%val = date(1:4)
214 1 : values_ref(2)%val = date(5:6)
215 1 : values_ref(3)%val = date(7:8)
216 1 : values_ref(4)%val = zone
217 1 : values_ref(5)%val = time(1:2)
218 1 : values_ref(6)%val = time(3:4)
219 1 : values_ref(7)%val = time(5:6)
220 1 : values_ref(8)%val = time(8:10)
221 : if (DTS%year == values_ref(1)%val .and. & ! LCOV_EXCL_LINE
222 : DTS%month == values_ref(2)%val .and. & ! LCOV_EXCL_LINE
223 : DTS%day == values_ref(3)%val .and. & ! LCOV_EXCL_LINE
224 : DTS%zone == values_ref(4)%val .and. & ! LCOV_EXCL_LINE
225 : DTS%hour == values_ref(5)%val .and. & ! LCOV_EXCL_LINE
226 : DTS%minute == values_ref(6)%val .and. & ! LCOV_EXCL_LINE
227 1 : DTS%second == values_ref(7)%val) exit
228 : end do
229 1 : assertion = assertion .and. logical(DTS%year == values_ref(1)%val, LK)
230 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `year` component.", int(__LINE__, IK))
231 1 : assertion = assertion .and. logical(DTS%month == values_ref(2)%val, LK)
232 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `month` component.", int(__LINE__, IK))
233 1 : assertion = assertion .and. logical(DTS%day == values_ref(3)%val, LK)
234 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `day` component.", int(__LINE__, IK))
235 1 : assertion = assertion .and. logical(DTS%zone == values_ref(4)%val, LK)
236 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `zone` component.", int(__LINE__, IK))
237 1 : assertion = assertion .and. logical(DTS%hour == values_ref(5)%val, LK)
238 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `hour` component.", int(__LINE__, IK))
239 1 : assertion = assertion .and. logical(DTS%minute == values_ref(6)%val, LK)
240 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `minute` component.", int(__LINE__, IK))
241 1 : assertion = assertion .and. logical(DTS%second == values_ref(7)%val, LK)
242 1 : call test%assert(assertion, SK_"@dateTimeInt_type(): The default constructor must correctly assign the `second` component.", int(__LINE__, IK))
243 :
244 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
245 :
246 9 : end procedure
247 :
248 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
249 :
250 1 : module procedure test_getJulianDay
251 : use pm_kind, only: RKC => RK, IKC => IK
252 : real(RKC) :: tol, julianDay, julianDay_ref
253 : real(RKC), parameter :: ABSTOL = epsilon(0._RKC) * 100
254 : integer(IKC) :: year, month, day, zone, hour, minute, second, millisecond
255 1 : assertion = .true._LK
256 :
257 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
258 :
259 1 : assertion = assertion .and. logical(abs(getJulianDay() - getJulianDay()) < 1._RKC / SECONDS_PER_DAY, LK)
260 1 : call test%assert(assertion, SK_"@test_getJulianDay(): The condition `getJulianDay() - getJulianDay() < 1._RKC / SECONDS_PER_DAY` must hold, unless the computation takes more than a few seconds!", int(__LINE__, IK))
261 :
262 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
263 :
264 1 : tol = ABSTOL
265 1 : julianDay_ref = 1720694.5_RKC
266 :
267 1 : year = -1_IKC
268 1 : month = +1_IKC
269 1 : day = +1_IKC
270 1 : zone = +0_IKC
271 1 : hour = +0_IKC
272 1 : minute = +0_IKC
273 1 : second = +0_IKC
274 1 : millisecond = +0_IKC
275 :
276 1 : call setAssertion(__LINE__, 1)
277 :
278 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
279 :
280 1 : tol = ABSTOL
281 1 : julianDay_ref = -.5_RKC
282 :
283 1 : year = -4713_IKC
284 1 : month = +11_IKC
285 1 : day = +24_IKC
286 1 : zone = +0_IKC
287 1 : hour = +0_IKC
288 1 : minute = +0_IKC
289 1 : second = +0_IKC
290 1 : millisecond = +0_IKC
291 :
292 1 : call setAssertion(__LINE__, 3)
293 :
294 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
295 :
296 1 : tol = ABSTOL
297 1 : julianDay_ref = 0._RKC
298 :
299 1 : year = -4713_IKC
300 1 : month = +11_IKC
301 1 : day = +24_IKC
302 1 : zone = +0_IKC
303 1 : hour = +12_IKC
304 1 : minute = +0_IKC
305 1 : second = +0_IKC
306 1 : millisecond = +0_IKC
307 :
308 1 : call setAssertion(__LINE__, 5)
309 :
310 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
311 :
312 1 : tol = ABSTOL
313 1 : julianDay_ref = +.5_RKC
314 :
315 1 : year = -4713_IKC
316 1 : month = +11_IKC
317 1 : day = +25_IKC
318 1 : zone = +0_IKC
319 1 : hour = +0_IKC
320 1 : minute = +0_IKC
321 1 : second = +0_IKC
322 1 : millisecond = +0_IKC
323 :
324 1 : call setAssertion(__LINE__, 3)
325 :
326 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
327 :
328 1 : tol = ABSTOL
329 1 : julianDay_ref = +2299160.5_RKC
330 :
331 1 : year = +1582_IKC
332 1 : month = +10_IKC
333 1 : day = +15_IKC
334 1 : zone = +0_IKC
335 1 : hour = +0_IKC
336 1 : minute = +0_IKC
337 1 : second = +0_IKC
338 1 : millisecond = +0_IKC
339 :
340 1 : call setAssertion(__LINE__, 3)
341 :
342 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
343 :
344 1 : tol = ABSTOL
345 1 : julianDay_ref = 2415385.5_RKC
346 :
347 1 : year = +1901_IKC
348 1 : month = +1_IKC
349 1 : day = +1_IKC
350 1 : zone = +0_IKC
351 1 : hour = +0_IKC
352 1 : minute = +0_IKC
353 1 : second = +0_IKC
354 1 : millisecond = +0_IKC
355 :
356 1 : call setAssertion(__LINE__, 1)
357 :
358 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
359 :
360 1 : tol = ABSTOL
361 1 : julianDay_ref = 2440587.5_RKC
362 :
363 1 : year = +1970_IKC
364 1 : month = +1_IKC
365 1 : day = +1_IKC
366 1 : zone = +0_IKC
367 1 : hour = +0_IKC
368 1 : minute = +0_IKC
369 1 : second = +0_IKC
370 1 : millisecond = +0_IKC
371 :
372 1 : call setAssertion(__LINE__, 1)
373 :
374 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
375 :
376 1 : tol = ABSTOL
377 1 : julianDay_ref = 2444239.5_RKC
378 :
379 1 : year = +1980_IKC
380 1 : month = +1_IKC
381 1 : day = +1_IKC
382 1 : zone = +0_IKC
383 1 : hour = +0_IKC
384 1 : minute = +0_IKC
385 1 : second = +0_IKC
386 1 : millisecond = +0_IKC
387 :
388 1 : call setAssertion(__LINE__, 1)
389 :
390 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
391 :
392 1 : tol = ABSTOL
393 1 : julianDay_ref = 2444240.5_RKC
394 :
395 1 : year = +1980_IKC
396 1 : month = +1_IKC
397 1 : day = +2_IKC
398 1 : zone = +0_IKC
399 1 : hour = +0_IKC
400 1 : minute = +0_IKC
401 1 : second = +0_IKC
402 1 : millisecond = +0_IKC
403 :
404 1 : call setAssertion(__LINE__, 3)
405 :
406 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
407 :
408 1 : tol = ABSTOL
409 1 : julianDay_ref = 2444239.25_RKC
410 :
411 1 : year = +1979_IKC
412 1 : month = +12_IKC
413 1 : day = +31_IKC
414 1 : zone = +0_IKC
415 1 : hour = +18_IKC
416 1 : minute = +0_IKC
417 1 : second = +0_IKC
418 1 : millisecond = +0_IKC
419 :
420 1 : call setAssertion(__LINE__, 5)
421 :
422 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
423 :
424 1 : tol = ABSTOL
425 1 : julianDay_ref = 2444239._RKC
426 :
427 1 : year = +1979_IKC
428 1 : month = +12_IKC
429 1 : day = +31_IKC
430 1 : zone = +360_IKC
431 1 : hour = +18_IKC
432 1 : minute = +0_IKC
433 1 : second = +0_IKC
434 1 : millisecond = +0_IKC
435 :
436 1 : call setAssertion(__LINE__, 5)
437 :
438 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
439 :
440 1 : tol = ABSTOL
441 1 : julianDay_ref = 2444239._RKC
442 :
443 1 : year = +1979_IKC
444 1 : month = +12_IKC
445 1 : day = +31_IKC
446 1 : zone = -360_IKC
447 1 : hour = +6_IKC
448 1 : minute = +0_IKC
449 1 : second = +0_IKC
450 1 : millisecond = +0_IKC
451 :
452 1 : call setAssertion(__LINE__, 5)
453 :
454 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
455 :
456 1 : tol = ABSTOL
457 1 : julianDay_ref = 38245308.75_RKC
458 :
459 1 : year = +99999_IKC
460 1 : month = +12_IKC
461 1 : day = +31_IKC
462 1 : zone = +0_IKC
463 1 : hour = +6_IKC
464 1 : minute = +0_IKC
465 1 : second = +0_IKC
466 1 : millisecond = +0_IKC
467 :
468 1 : call setAssertion(__LINE__, 5)
469 :
470 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
471 :
472 : contains
473 :
474 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
475 :
476 13 : subroutine setAssertion(line, minarg)
477 :
478 : integer, intent(in) :: line, minarg
479 :
480 13 : if (minarg > 8) return
481 13 : julianDay = getJulianDay(year, month, day, zone, hour, minute, second, millisecond)
482 13 : call report(line, 8)
483 117 : julianDay = getJulianDay([year, month, day, zone, hour, minute, second, millisecond])
484 13 : call report(line, 8)
485 :
486 13 : if (minarg > 7) return
487 13 : julianDay = getJulianDay(year, month, day, zone, hour, minute, second)
488 13 : call report(line, 7)
489 104 : julianDay = getJulianDay([year, month, day, zone, hour, minute, second])
490 13 : call report(line, 7)
491 :
492 13 : if (minarg > 6) return
493 13 : julianDay = getJulianDay(year, month, day, zone, hour, minute)
494 13 : call report(line, 6)
495 91 : julianDay = getJulianDay([year, month, day, zone, hour, minute])
496 13 : call report(line, 6)
497 :
498 13 : if (minarg > 5) return
499 13 : julianDay = getJulianDay(year, month, day, zone, hour)
500 13 : call report(line, 5)
501 78 : julianDay = getJulianDay([year, month, day, zone, hour])
502 13 : call report(line, 5)
503 :
504 13 : if (minarg > 4) return
505 8 : julianDay = getJulianDay(year, month, day, zone)
506 8 : call report(line, 4)
507 40 : julianDay = getJulianDay([year, month, day, zone])
508 8 : call report(line, 4)
509 :
510 8 : if (minarg > 3) return
511 8 : julianDay = getJulianDay(year, month, day)
512 8 : call report(line, 3)
513 32 : julianDay = getJulianDay([year, month, day])
514 8 : call report(line, 3)
515 :
516 8 : if (minarg > 2) return
517 4 : julianDay = getJulianDay(year, month)
518 4 : call report(line, 2)
519 12 : julianDay = getJulianDay([year, month])
520 4 : call report(line, 2)
521 :
522 4 : if (minarg > 1) return
523 4 : julianDay = getJulianDay(year)
524 4 : call report(line, 1)
525 8 : julianDay = getJulianDay([year])
526 4 : call report(line, 1)
527 :
528 : end subroutine
529 :
530 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
531 :
532 152 : subroutine report(line, narg)
533 : integer, intent(in) :: line, narg
534 : real(RKC) :: diff
535 152 : diff = abs(julianDay - julianDay_ref)
536 152 : assertion = assertion .and. logical(diff <= tol * abs(julianDay_ref) + epsilon(0._RKC), LK)
537 152 : if (test%traceable .and. .not. assertion) then
538 : ! LCOV_EXCL_START
539 : write(test%disp%unit,"(*(g0,:,', '))")
540 : write(test%disp%unit,"(*(g0,:,', '))") "year ", narg
541 : write(test%disp%unit,"(*(g0,:,', '))") "year ", year
542 : write(test%disp%unit,"(*(g0,:,', '))") "month ", month
543 : write(test%disp%unit,"(*(g0,:,', '))") "day ", day
544 : write(test%disp%unit,"(*(g0,:,', '))") "zone ", zone
545 : write(test%disp%unit,"(*(g0,:,', '))") "hour ", hour
546 : write(test%disp%unit,"(*(g0,:,', '))") "minute ", minute
547 : write(test%disp%unit,"(*(g0,:,', '))") "second ", second
548 : write(test%disp%unit,"(*(g0,:,', '))") "millisecond ", millisecond
549 : write(test%disp%unit,"(*(g0,:,', '))") "julianDay_ref ", julianDay_ref
550 : write(test%disp%unit,"(*(g0,:,', '))") "julianDay ", julianDay
551 : write(test%disp%unit,"(*(g0,:,', '))") "diff ", diff
552 : write(test%disp%unit,"(*(g0,:,', '))") "tol ", tol
553 : write(test%disp%unit,"(*(g0,:,', '))") "reltol ", tol * abs(julianDay_ref)
554 : write(test%disp%unit,"(*(g0,:,', '))")
555 : ! LCOV_EXCL_STOP
556 : end if
557 152 : call test%assert(assertion, SK_"@test_getJulianDay(): The Julian day must be computed correctly for the specified date and time with narg = "//getStr(narg), int(line, IK))
558 152 : end subroutine
559 :
560 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
561 :
562 : end procedure
563 :
564 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
565 :
566 1 : module procedure test_getDateTimeShifted
567 :
568 : use pm_kind, only: RKC => RK, IKC => IK
569 : integer(IKC), allocatable :: dateTimeShifted(:), dateTimeShifted_ref(:)
570 : integer(IKC) :: year, month, day, zone, hour, minute, second, millisecond
571 : !real(RKC), parameter :: ABSTOL = epsilon(0._RKC) * 100
572 : real(RKC) :: amount
573 1 : assertion = .true._LK
574 :
575 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
576 :
577 10 : dateTimeShifted_ref = getDateTime()
578 10 : dateTimeShifted = getDateTimeShifted(1._RKC)
579 1 : dateTimeShifted_ref(3) = dateTimeShifted_ref(3) + 1_IKC
580 14 : assertion = assertion .and. logical(all(dateTimeShifted(1:6) == dateTimeShifted_ref(1:6)), LK) .or. any([dateTimeShifted_ref(1:3), dateTimeShifted_ref(5:6)] == 1_IK)
581 1 : call test%assert(assertion, SK_"@test_getDateTimeShifted(): The input time must be shifted correctly. dateTimeShifted = "//getStr(dateTimeShifted)//SK_", dateTimeShifted_ref = "//getStr(dateTimeShifted_ref), int(__LINE__, IK))
582 :
583 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
584 :
585 10 : dateTimeShifted_ref = [integer(IKC) :: +2000, +1, +1, +0, +0, +0, +0, +0]
586 1 : amount = +365._RKC
587 1 : year = +1999_IKC
588 1 : month = +1_IKC
589 1 : day = +1_IKC
590 1 : zone = +0_IKC
591 1 : hour = +0_IKC
592 1 : minute = +0_IKC
593 1 : second = +0_IKC
594 1 : millisecond = +0_IKC
595 :
596 1 : call setAssertion(__LINE__, 1)
597 :
598 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
599 :
600 10 : dateTimeShifted_ref = [integer(IKC) :: +0, +12, +30, +660, +19, +12, +0, +0]
601 1 : amount = -1.2_RKC
602 1 : year = +1_IKC
603 1 : month = +1_IKC
604 1 : day = +1_IKC
605 1 : zone = +660_IKC
606 1 : hour = +0_IKC
607 1 : minute = +0_IKC
608 1 : second = +0_IKC
609 1 : millisecond = +0_IKC
610 :
611 1 : call setAssertion(__LINE__, 4)
612 :
613 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
614 :
615 10 : dateTimeShifted_ref = [integer(IKC) :: +0, +1, +3, -660, +8, +0, +0, +0]
616 1 : amount = +2.5_RKC
617 1 : year = -1_IKC
618 1 : month = +12_IKC
619 1 : day = +31_IKC
620 1 : zone = -660_IKC
621 1 : hour = +20_IKC
622 1 : minute = +0_IKC
623 1 : second = +0_IKC
624 1 : millisecond = +0_IKC
625 :
626 1 : call setAssertion(__LINE__, 5)
627 :
628 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
629 :
630 10 : dateTimeShifted_ref = [integer(IKC) :: +1999, +12, +31, +0, +0, +0, +0, +0]
631 1 : amount = -366._RKC
632 1 : year = +2000_IKC
633 1 : month = +12_IKC
634 1 : day = +31_IKC
635 1 : zone = +0_IKC
636 1 : hour = +0_IKC
637 1 : minute = +0_IKC
638 1 : second = +0_IKC
639 1 : millisecond = +0_IKC
640 :
641 1 : call setAssertion(__LINE__, 3)
642 :
643 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
644 :
645 10 : dateTimeShifted_ref = [integer(IKC) :: +1998, +11, +21, +660, +8, +21, +35, +847]
646 1 : amount = -100._RKC
647 1 : year = +1999_IKC
648 1 : month = +3_IKC
649 1 : day = +1_IKC
650 1 : zone = +660_IKC
651 1 : hour = +8_IKC
652 1 : minute = +21_IKC
653 1 : second = +35_IKC
654 1 : millisecond = +847_IKC
655 :
656 1 : call setAssertion(__LINE__, 8)
657 :
658 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
659 :
660 10 : dateTimeShifted_ref = [integer(IKC) :: +2002, +12, +31, -660, +0, +0, +0, +0]
661 1 : amount = +2*365._RKC
662 1 : year = +2000_IKC
663 1 : month = +12_IKC
664 1 : day = +31_IKC
665 1 : zone = -660_IKC
666 1 : hour = +0_IKC
667 1 : minute = +0_IKC
668 1 : second = +0_IKC
669 1 : millisecond = +0_IKC
670 :
671 1 : call setAssertion(__LINE__, 4)
672 :
673 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
674 :
675 : contains
676 :
677 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
678 :
679 6 : subroutine setAssertion(line, minarg)
680 :
681 : integer, intent(in) :: line, minarg
682 :
683 6 : if (minarg > 8) return
684 60 : dateTimeShifted = getDateTimeShifted(amount, year, month, day, zone, hour, minute, second, millisecond)
685 6 : call report(line, 8)
686 108 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day, zone, hour, minute, second, millisecond])
687 6 : call report(line, 8)
688 :
689 6 : if (minarg > 7) return
690 50 : dateTimeShifted = getDateTimeShifted(amount, year, month, day, zone, hour, minute, second)
691 5 : call report(line, 7)
692 85 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day, zone, hour, minute, second])
693 5 : call report(line, 7)
694 :
695 5 : if (minarg > 6) return
696 50 : dateTimeShifted = getDateTimeShifted(amount, year, month, day, zone, hour, minute)
697 5 : call report(line, 6)
698 80 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day, zone, hour, minute])
699 5 : call report(line, 6)
700 :
701 5 : if (minarg > 5) return
702 50 : dateTimeShifted = getDateTimeShifted(amount, year, month, day, zone, hour)
703 5 : call report(line, 5)
704 75 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day, zone, hour])
705 5 : call report(line, 5)
706 :
707 5 : if (minarg > 4) return
708 40 : dateTimeShifted = getDateTimeShifted(amount, year, month, day, zone)
709 4 : call report(line, 4)
710 56 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day, zone])
711 4 : call report(line, 4)
712 :
713 4 : if (minarg > 3) return
714 20 : dateTimeShifted = getDateTimeShifted(amount, year, month, day)
715 2 : call report(line, 3)
716 26 : dateTimeShifted = getDateTimeShifted(amount, [year, month, day])
717 2 : call report(line, 3)
718 :
719 2 : if (minarg > 2) return
720 10 : dateTimeShifted = getDateTimeShifted(amount, year, month)
721 1 : call report(line, 2)
722 12 : dateTimeShifted = getDateTimeShifted(amount, [year, month])
723 1 : call report(line, 2)
724 :
725 1 : if (minarg > 1) return
726 10 : dateTimeShifted = getDateTimeShifted(amount, year)
727 1 : call report(line, 1)
728 11 : dateTimeShifted = getDateTimeShifted(amount, [year])
729 1 : call report(line, 1)
730 :
731 : end subroutine
732 :
733 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
734 :
735 58 : subroutine report(line, narg)
736 : integer, intent(in) :: line, narg
737 522 : assertion = assertion .and. logical(all(dateTimeShifted == dateTimeShifted_ref), LK)
738 58 : if (test%traceable .and. .not. assertion) then
739 : ! LCOV_EXCL_START
740 : write(test%disp%unit,"(*(g0,:,', '))")
741 : write(test%disp%unit,"(*(g0,:,', '))") "narg ", narg
742 : write(test%disp%unit,"(*(g0,:,', '))") "year ", year
743 : write(test%disp%unit,"(*(g0,:,', '))") "month ", month
744 : write(test%disp%unit,"(*(g0,:,', '))") "day ", day
745 : write(test%disp%unit,"(*(g0,:,', '))") "zone ", zone
746 : write(test%disp%unit,"(*(g0,:,', '))") "hour ", hour
747 : write(test%disp%unit,"(*(g0,:,', '))") "minute ", minute
748 : write(test%disp%unit,"(*(g0,:,', '))") "second ", second
749 : write(test%disp%unit,"(*(g0,:,', '))") "millisecond ", millisecond
750 : write(test%disp%unit,"(*(g0,:,', '))") "dateTimeShifted ", dateTimeShifted
751 : write(test%disp%unit,"(*(g0,:,', '))") "dateTimeShifted_ref = ", dateTimeShifted_ref
752 : write(test%disp%unit,"(*(g0,:,', '))")
753 : ! LCOV_EXCL_STOP
754 : end if
755 58 : call test%assert(assertion, SK_"@test_getDateTimeShifted(): The input time must be shifted correctly with narg = "//getStr(narg), int(line, IK))
756 58 : end subroutine
757 :
758 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
759 :
760 : end procedure
761 :
762 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
763 :
764 1 : module procedure test_getDateTimeDiff
765 :
766 : use pm_kind, only: RKC => RK, IKC => IK
767 : integer(IKC), allocatable :: DateTime1(:), DateTime2(:)
768 : ! \warning
769 : ! Note that the conversion of time difference to integer days has a roughly single precision accuracy.
770 : ! As such, the following tests will fail if ABSTOL is set to anything significantly larger than single precision 32-bit accuracy.
771 : real(RKC), parameter :: ABSTOL = real(epsilon(0.), RKC)
772 : real(RKC) :: dateTimeDiff, dateTimeDiff_ref, reltol
773 1 : assertion = .true._LK
774 :
775 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
776 :
777 1 : dateTimeDiff_ref = 1._RKC
778 10 : DateTime1 = getDateTime(1999_IKC, 3_IKC, 1_IKC)
779 10 : DateTime2 = getDateTime(1999_IKC, 2_IKC, 28_IKC)
780 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
781 1 : call report(__LINE__)
782 :
783 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
784 :
785 1 : dateTimeDiff_ref = 2._RKC
786 10 : DateTime1 = getDateTime(2000_IKC, 3_IKC, 1_IKC)
787 10 : DateTime2 = getDateTime(2000_IKC, 2_IKC, 28_IKC)
788 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
789 1 : call report(__LINE__)
790 :
791 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
792 :
793 1 : dateTimeDiff_ref = -364._RKC
794 10 : DateTime1 = getDateTime(2019_IKC, 1_IKC, 1_IKC)
795 10 : DateTime2 = getDateTime(2019_IKC, 12_IKC, 31_IKC)
796 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
797 1 : call report(__LINE__)
798 :
799 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
800 :
801 1 : dateTimeDiff_ref = -365._RKC
802 10 : DateTime1 = getDateTime(2020_IKC, 1_IKC, 1_IKC)
803 10 : DateTime2 = getDateTime(2020_IKC, 12_IKC, 31_IKC)
804 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
805 1 : call report(__LINE__)
806 :
807 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
808 :
809 1 : dateTimeDiff_ref = -1._RKC
810 10 : DateTime1 = getDateTime(1_IKC, 1_IKC, 1_IKC, zone = +12_IKC * 60_IKC)
811 10 : DateTime2 = getDateTime(1_IKC, 1_IKC, 1_IKC, zone = -12_IKC * 60_IKC)
812 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
813 1 : call report(__LINE__)
814 :
815 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
816 :
817 1 : dateTimeDiff_ref = +1._RKC
818 10 : DateTime1 = getDateTime(-1_IKC, 1_IKC, 1_IKC, zone = -12_IKC * 60_IKC)
819 10 : DateTime2 = getDateTime(-1_IKC, 1_IKC, 1_IKC, zone = +12_IKC * 60_IKC)
820 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
821 1 : call report(__LINE__)
822 :
823 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
824 :
825 1 : dateTimeDiff_ref = +8334.7544704633765_RKC
826 10 : DateTime1 = getDateTime(+2022_IKC, +10_IKC, +26_IKC, +0_IKC, +18_IKC, +6_IKC, +26_IKC, +248_IKC)
827 10 : DateTime2 = getDateTime(2000_IK)
828 1 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
829 1 : call report(__LINE__)
830 :
831 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
832 :
833 1 : block
834 : use pm_distUnif, only: getUnifRand
835 : integer :: i
836 5001 : do i = 1, 5000
837 : ! \warning
838 : ! Note that the conversion of time difference to integer days has a roughly single precision accuracy.
839 : ! As such, the following tests will fail if ABSTOL is set to anything significantly larger than single precision 32-bit accuracy.
840 5000 : dateTimeDiff_ref = getUnifRand(-300000._RKC, +300000._RKC)
841 50000 : DateTime1 = getDateTime()
842 50000 : DateTime2 = getDateTimeShifted(-dateTimeDiff_ref, DateTime1)
843 5000 : dateTimeDiff = getDateTimeDiff(DateTime1, DateTime2)
844 5001 : call report(__LINE__)
845 : end do
846 : end block
847 :
848 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
849 :
850 : contains
851 :
852 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
853 :
854 5007 : subroutine report(line)
855 : integer, intent(in) :: line
856 : real(RKC) :: diff
857 5007 : diff = abs(dateTimeDiff - dateTimeDiff_ref)
858 5007 : reltol = abs(dateTimeDiff_ref) * ABSTOL + epsilon(0._RKC)
859 5007 : assertion = assertion .and. logical(diff <= reltol, LK)
860 5007 : if (test%traceable .and. .not. assertion) then
861 : ! LCOV_EXCL_START
862 : write(test%disp%unit,"(*(g0,:,', '))")
863 : write(test%disp%unit,"(*(g0,:,', '))") "DateTime1 ", DateTime1
864 : write(test%disp%unit,"(*(g0,:,', '))") "DateTime2 ", DateTime2
865 : write(test%disp%unit,"(*(g0,:,', '))") "ABSTOL ", ABSTOL
866 : write(test%disp%unit,"(*(g0,:,', '))") "reltol ", reltol
867 : write(test%disp%unit,"(*(g0,:,', '))") "diff ", diff
868 : write(test%disp%unit,"(*(g0,:,', '))") "dateTimeDiff ", dateTimeDiff
869 : write(test%disp%unit,"(*(g0,:,', '))") "dateTimeDiff_ref ", dateTimeDiff_ref
870 : write(test%disp%unit,"(*(g0,:,', '))")
871 : ! LCOV_EXCL_STOP
872 : end if
873 5007 : call test%assert(assertion, SK_"@test_getDateTimeShifted(): The input time must be shifted correctly.", int(line, IK))
874 5007 : end subroutine
875 :
876 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
877 :
878 : end procedure
879 :
880 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
881 :
882 1 : module procedure test_getDateTimeUTC
883 :
884 : use pm_distUnif, only: getUnifRand
885 : use pm_kind, only: RKC => RK, IKC => IK
886 : integer(IKC), allocatable :: DateTime(:), DateTimeUTC(:), DateTimeUTC_ref(:)
887 : !! \warning
888 : !! Note that the conversion of time difference to integer days has a roughly single precision accuracy.
889 : !! As such, the following tests will fail if ABSTOL is set to anything significantly larger than single precision 32-bit accuracy.
890 : !real(RKC), parameter :: ABSTOL = real(epsilon(0.), RKC)
891 : !real(RKC) :: dateTimeDiff, dateTimeDiff_ref, reltol
892 : integer :: i, ub
893 : integer(IKC) :: zone
894 1 : assertion = .true._LK
895 :
896 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
897 :
898 1 : do i = 1, 10
899 2 : DateTime = getDateTime()
900 10 : DateTimeUTC = getDateTimeUTC()
901 10 : DateTimeUTC_ref = getDateTimeShifted(-DateTime(4) / 1440._RKC, DateTime)
902 1 : DateTimeUTC_ref(4) = 0_IKC
903 7 : assertion = logical(all(DateTimeUTC(1:6) == DateTimeUTC_ref(1:6)), LK)
904 1 : if (assertion) exit
905 : end do
906 1 : call test%assert(assertion, SK_"@test_getDateTimeUTC(): The current UTC time must be computed correctly.", int(__LINE__, IK))
907 :
908 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
909 :
910 5001 : do i = 1, 5000
911 :
912 5000 : if (i == 1) then
913 : zone = -12_IKC * 60_IKC
914 4999 : elseif (i == 2) then
915 : zone = +14_IKC * 60_IKC
916 : else
917 4998 : zone = getUnifRand(-12_IKC * 60_IKC, +14_IKC * 60_IKC)
918 : end if
919 :
920 5000 : DateTime = getDateTime()
921 5000 : DateTime(4) = zone
922 :
923 : ub = 4
924 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1:ub))
925 50000 : DateTimeUTC_ref = getDateTimeShifted(-zone / 1440._RKC, DateTime(1:ub))
926 50000 : DateTimeUTC_ref(ub + 1:) = [DateTimeUTC(ub + 1:)]
927 5000 : DateTimeUTC_ref(4) = 0_IKC
928 5000 : call report(__LINE__)
929 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1), DateTime(2), DateTime(3), DateTime(4))
930 :
931 : ub = 5
932 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1:ub))
933 50000 : DateTimeUTC_ref = getDateTimeShifted(-zone / 1440._RKC, DateTime(1:ub))
934 40000 : DateTimeUTC_ref(ub + 1:) = [DateTimeUTC(ub + 1:)]
935 5000 : DateTimeUTC_ref(4) = 0_IKC
936 5000 : call report(__LINE__)
937 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5))
938 :
939 : ub = 6
940 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1:ub))
941 50000 : DateTimeUTC_ref = getDateTimeShifted(-zone / 1440._RKC, DateTime(1:ub))
942 30000 : DateTimeUTC_ref(ub + 1:) = [DateTimeUTC(ub + 1:)]
943 5000 : DateTimeUTC_ref(4) = 0_IKC
944 5000 : call report(__LINE__)
945 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(6))
946 :
947 : ub = 7
948 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1:ub))
949 50000 : DateTimeUTC_ref = getDateTimeShifted(-zone / 1440._RKC, DateTime(1:ub))
950 20000 : DateTimeUTC_ref(ub + 1:) = [DateTimeUTC(ub + 1:)]
951 5000 : DateTimeUTC_ref(4) = 0_IKC
952 5000 : call report(__LINE__)
953 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(7))
954 :
955 : ub = 8
956 50000 : DateTimeUTC = getDateTimeUTC(DateTime(1:ub))
957 50000 : DateTimeUTC_ref = getDateTimeShifted(-zone / 1440._RKC, DateTime(1:ub))
958 10000 : DateTimeUTC_ref(ub + 1:) = [DateTimeUTC(ub + 1:)]
959 5000 : DateTimeUTC_ref(4) = 0_IKC
960 5000 : call report(__LINE__)
961 50001 : DateTimeUTC = getDateTimeUTC(DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(7), DateTime(8))
962 :
963 : end do
964 :
965 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
966 :
967 : contains
968 :
969 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
970 :
971 25000 : subroutine report(line)
972 : integer, intent(in) :: line
973 225000 : assertion = assertion .and. logical(all(DateTimeUTC == DateTimeUTC_ref), LK)
974 25000 : if (test%traceable .and. .not. assertion) then
975 : ! LCOV_EXCL_START
976 : write(test%disp%unit,"(*(g0,:,', '))")
977 : write(test%disp%unit,"(*(g0,:,', '))") "DateTimeUTC ", DateTimeUTC
978 : write(test%disp%unit,"(*(g0,:,', '))") "DateTimeUTC_ref", DateTimeUTC_ref
979 : write(test%disp%unit,"(*(g0,:,', '))")
980 : ! LCOV_EXCL_STOP
981 : end if
982 25000 : call test%assert(assertion, SK_"@test_getDateTimeUTC(): The input time must be shifted correctly.", int(line, IK))
983 25000 : end subroutine
984 :
985 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
986 :
987 : end procedure
988 :
989 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
990 :
991 1 : module procedure test_getDateTimeNewZone
992 :
993 : use pm_distUnif, only: getUnifRand
994 : use pm_kind, only: RKC => RK, IKC => IK
995 : integer(IKC), allocatable :: DateTime(:), DateTimeNewZone(:), DateTimeNewZone_ref(:)
996 : integer(IKC) :: zone, newzone
997 : real(RKC) :: zoneshift
998 : integer :: i, ub
999 1 : assertion = .true._LK
1000 :
1001 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1002 :
1003 11 : do i = 1, 10
1004 100 : DateTime = getDateTime()
1005 10 : zone = DateTime(4)
1006 10 : newzone = getUnifRand(-12_IKC * 60_IKC, +14_IKC * 60_IKC)
1007 100 : DateTimeNewZone = getDateTimeNewZone(newzone)
1008 10 : zoneshift = -(DateTime(4) - newzone) / 1440._RKC
1009 100 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime)
1010 40 : DateTimeNewZone_ref(6:8) = DateTimeNewZone(6:8)
1011 10 : DateTimeNewZone_ref(4) = newzone
1012 11 : call report(__LINE__, i /= 10)
1013 : end do
1014 :
1015 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1016 :
1017 1 : newzone = -300_IK
1018 10 : DateTime = [integer(IKC) :: 1999_IK, 3_IK, 1_IK, +660_IK, 8_IK, 21_IK, 35_IK, 847_IK]
1019 10 : DateTimeNewZone_ref = [integer(IKC) :: +1999, +2, +28, -300, +16, +21, +35, +847]
1020 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1021 1 : zone = DateTime(4)
1022 1 : call report(__LINE__)
1023 :
1024 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1025 :
1026 1 : newzone = -300_IK
1027 10 : DateTime = [integer(IKC) :: 2000_IK, 3_IK, 1_IK, +660_IK, 8_IK, 21_IK, 35_IK, 847_IK]
1028 10 : DateTimeNewZone_ref = [integer(IKC) :: +2000, +2, +29, -300, +16, +21, +35, +847]
1029 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1030 1 : zone = DateTime(4)
1031 1 : call report(__LINE__)
1032 :
1033 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1034 :
1035 1 : newzone = +300_IK
1036 10 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK, 21_IK, 35_IK, 847_IK]
1037 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +300, +10, +21, +35, +847]
1038 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1039 1 : zone = DateTime(4)
1040 1 : call report(__LINE__)
1041 :
1042 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1043 :
1044 1 : newzone = +300_IK
1045 9 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK, 21_IK, 35_IK]
1046 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +300, +10, +21, +35, +0]
1047 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1048 1 : zone = DateTime(4)
1049 1 : call report(__LINE__)
1050 :
1051 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1052 :
1053 1 : newzone = +313_IK
1054 8 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK, 21_IK]
1055 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +313, +10, +34, +0, +0]
1056 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1057 1 : zone = DateTime(4)
1058 1 : call report(__LINE__)
1059 :
1060 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1061 :
1062 1 : newzone = +300_IK
1063 8 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK, 21_IK]
1064 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +300, +10, +21, +0, +0]
1065 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1066 1 : zone = DateTime(4)
1067 1 : call report(__LINE__)
1068 :
1069 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1070 :
1071 1 : newzone = +660_IK
1072 7 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK]
1073 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +660, +16, +0, +0, +0]
1074 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1075 1 : zone = DateTime(4)
1076 1 : call report(__LINE__)
1077 :
1078 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1079 :
1080 1 : newzone = +0_IK
1081 7 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK]
1082 10 : DateTimeNewZone_ref = [integer(IKC) :: +2001, +1, +1, +0, +5, +0, +0, +0]
1083 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1084 1 : zone = DateTime(4)
1085 1 : call report(__LINE__)
1086 :
1087 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1088 :
1089 1 : newzone = -660_IK
1090 7 : DateTime = [integer(IKC) :: 2000_IK, 12_IK, 31_IK, -660_IK, 18_IK]
1091 10 : DateTimeNewZone_ref = [integer(IKC) :: +2000, +12, +31, -660, +18, +0, +0, +0]
1092 10 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime)
1093 1 : zone = DateTime(4)
1094 1 : call report(__LINE__)
1095 :
1096 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1097 :
1098 5001 : do i = 1, 5000
1099 :
1100 5000 : if (i == 1) then
1101 1 : zone = -12_IKC * 60_IKC
1102 4999 : elseif (i == 2) then
1103 1 : zone = +14_IKC * 60_IKC
1104 : else
1105 4998 : zone = getUnifRand(-12_IKC * 60_IKC, +14_IKC * 60_IKC)
1106 : end if
1107 :
1108 5000 : newzone = getUnifRand(-12_IKC * 60_IKC, +14_IKC * 60_IKC)
1109 5000 : zoneshift = -(zone - newzone) / 1440._RKC
1110 50000 : DateTime = getDateTime()
1111 5000 : DateTime(4) = zone
1112 :
1113 : ub = 4
1114 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1:ub))
1115 50000 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime(1:ub))
1116 50000 : DateTimeNewZone_ref(ub + 1:) = [DateTimeNewZone(ub + 1:)]
1117 5000 : DateTimeNewZone_ref(4) = newzone
1118 5000 : call report(__LINE__)
1119 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1), DateTime(2), DateTime(3), DateTime(4))
1120 :
1121 : ub = 5
1122 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1:ub))
1123 50000 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime(1:ub))
1124 40000 : DateTimeNewZone_ref(ub + 1:) = [DateTimeNewZone(ub + 1:)]
1125 5000 : DateTimeNewZone_ref(4) = newzone
1126 5000 : call report(__LINE__)
1127 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5))
1128 :
1129 : ub = 6
1130 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1:ub))
1131 50000 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime(1:ub))
1132 30000 : DateTimeNewZone_ref(ub + 1:) = [DateTimeNewZone(ub + 1:)]
1133 5000 : DateTimeNewZone_ref(4) = newzone
1134 5000 : call report(__LINE__)
1135 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(6))
1136 :
1137 : ub = 7
1138 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1:ub))
1139 50000 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime(1:ub))
1140 20000 : DateTimeNewZone_ref(ub + 1:) = [DateTimeNewZone(ub + 1:)]
1141 5000 : DateTimeNewZone_ref(4) = newzone
1142 5000 : call report(__LINE__)
1143 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(7))
1144 :
1145 : ub = 8
1146 50000 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1:ub))
1147 50000 : DateTimeNewZone_ref = getDateTimeShifted(zoneshift, DateTime(1:ub))
1148 10000 : DateTimeNewZone_ref(ub + 1:) = [DateTimeNewZone(ub + 1:)]
1149 5000 : DateTimeNewZone_ref(4) = newzone
1150 5000 : call report(__LINE__)
1151 50001 : DateTimeNewZone = getDateTimeNewZone(newzone, DateTime(1), DateTime(2), DateTime(3), DateTime(4), DateTime(5), DateTime(7), DateTime(8))
1152 :
1153 : end do
1154 :
1155 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1156 :
1157 : contains
1158 :
1159 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1160 :
1161 25019 : subroutine report(line, continued)
1162 : integer, intent(in) :: line
1163 : logical, intent(in), optional :: continued
1164 225171 : assertion = assertion .and. logical(all(DateTimeNewZone == DateTimeNewZone_ref), LK)
1165 25019 : if (present(continued)) then
1166 10 : assertion = assertion .or. logical(continued, LK)
1167 : end if
1168 25019 : if (test%traceable .and. .not. assertion) then
1169 : ! LCOV_EXCL_START
1170 : write(test%disp%unit,"(*(g0,:,', '))")
1171 : write(test%disp%unit,"(*(g0,:,', '))") "zone ", zone
1172 : write(test%disp%unit,"(*(g0,:,', '))") "newzone ", newzone
1173 : write(test%disp%unit,"(*(g0,:,', '))") "DateTime ", DateTime
1174 : write(test%disp%unit,"(*(g0,:,', '))") "DateTimeNewZone ", DateTimeNewZone
1175 : write(test%disp%unit,"(*(g0,:,', '))") "DateTimeNewZone_ref", DateTimeNewZone_ref
1176 : write(test%disp%unit,"(*(g0,:,', '))")
1177 : ! LCOV_EXCL_STOP
1178 : end if
1179 25019 : call test%assert(assertion, SK_"@test_getDateTimeNewZone(): The time in the new zone must be computed correctly.", int(line, IK))
1180 25019 : end subroutine
1181 :
1182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1183 :
1184 : end procedure
1185 :
1186 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1187 :
1188 1 : module procedure test_getDateTime_1
1189 :
1190 : use pm_distUnif, only: getUnifRand
1191 : use pm_kind, only: RKC => RK, IKC => IK
1192 : integer(IKC), allocatable :: Values(:), values_ref(:)
1193 : !integer(IKC) :: year, month, day, zone, hour, minute, second, millisecond
1194 : real(RKC) :: julianDay
1195 : integer :: i
1196 1 : assertion = .true._LK
1197 :
1198 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1199 :
1200 : ! check the condition `if (Values(5) == 24_IKC) then` in the code.
1201 10 : values_ref = [integer(IKC) :: 1, 1, 1, -60, 23, 0, 0, 0]
1202 1 : julianDay = getJulianDay(values_ref)
1203 10 : values_ref = [integer(IKC) :: 1, 1, 2, 0, 0, 0, 0, 0]
1204 10 : Values = getDateTimeNewZone(values_ref(4), getDateTime(julianDay))
1205 1 : call report(__LINE__)
1206 :
1207 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1208 :
1209 501 : do i = 1, 500
1210 :
1211 5000 : values_ref = getDateTime()
1212 500 : julianDay = getJulianDay(values_ref)
1213 5000 : Values = getDateTimeNewZone(values_ref(4), getDateTime(julianDay))
1214 500 : call report(__LINE__)
1215 :
1216 5000 : Values = getDateTime(julianDay, values_ref(4))
1217 500 : call report(__LINE__, values_ref(4))
1218 :
1219 5000 : Values = getDateTime(julianDay, values_ref(4))
1220 500 : call report(__LINE__, values_ref(4))
1221 :
1222 500 : values_ref(4) = getUnifRand(-12_IKC * 60_IKC, +14_IKC * 60_IKC)
1223 500 : julianDay = getJulianDay(values_ref)
1224 5000 : Values = getDateTime(julianDay, values_ref(4))
1225 500 : call report(__LINE__, values_ref(4))
1226 :
1227 : !year = +values_ref(1)
1228 : !month = +values_ref(2)
1229 : !day = +values_ref(3)
1230 : !zone = +values_ref(4)
1231 : !hour = +values_ref(5)
1232 : !minute = +values_ref(6)
1233 : !second = +values_ref(7)
1234 : !millisecond = +values_ref(8)
1235 :
1236 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3), values_ref(4), values_ref(5), values_ref(6), values_ref(7), values_ref(8))
1237 500 : call report(__LINE__)
1238 :
1239 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3), values_ref(4), values_ref(5), values_ref(6), values_ref(7))
1240 500 : values_ref(8) = 0_IKC
1241 500 : call report(__LINE__)
1242 :
1243 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3), values_ref(4), values_ref(5), values_ref(6))
1244 500 : values_ref(7) = 0_IKC
1245 500 : call report(__LINE__)
1246 :
1247 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3), values_ref(4), values_ref(5))
1248 500 : values_ref(6) = 0_IKC
1249 500 : call report(__LINE__)
1250 :
1251 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3), values_ref(4))
1252 500 : values_ref(5) = 0_IKC
1253 500 : call report(__LINE__)
1254 :
1255 5000 : Values = getDateTime(values_ref(1), values_ref(2), values_ref(3))
1256 500 : values_ref(4) = 0_IKC
1257 500 : call report(__LINE__)
1258 :
1259 5000 : Values = getDateTime(values_ref(1), values_ref(2))
1260 500 : values_ref(3) = 1_IKC
1261 500 : call report(__LINE__)
1262 :
1263 5000 : Values = getDateTime(values_ref(1))
1264 500 : values_ref(2) = 1_IKC
1265 501 : call report(__LINE__)
1266 :
1267 : end do
1268 :
1269 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1270 :
1271 : contains
1272 :
1273 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1274 :
1275 6001 : subroutine report(line, zone)
1276 : integer, intent(in) :: line
1277 : integer, intent(in), optional :: zone
1278 54009 : assertion = assertion .and. logical(all(Values == values_ref), LK)
1279 6001 : if (test%traceable .and. .not. assertion) then
1280 : ! LCOV_EXCL_START
1281 : write(test%disp%unit,"(*(g0,:,', '))")
1282 : if (present(zone)) then
1283 : write(test%disp%unit,"(*(g0,:,', '))") "zone ", zone
1284 : end if
1285 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
1286 : write(test%disp%unit,"(*(g0,:,', '))") "values_ref ", values_ref
1287 : write(test%disp%unit,"(*(g0,:,', '))")
1288 : ! LCOV_EXCL_STOP
1289 : end if
1290 6001 : call test%assert(assertion, SK_"@test_getDateTimeNewZone(): The time in the new zone must be computed correctly.", int(line, IK))
1291 6001 : end subroutine
1292 :
1293 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1294 :
1295 : end procedure
1296 :
1297 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1298 :
1299 1 : module procedure test_getDateTime_2
1300 :
1301 : use pm_distUnif, only: getUnifRand
1302 : use pm_kind, only: RKC => RK, IKC => IK, SKC => SK
1303 1 : character(:,SKC), allocatable :: string, string_ref
1304 : character(2,SKC), parameter :: SPECIFIER(*) = [ "%a", "%A", "%b", "%B", "%c", "%C", "%d", "%D", "%e", "%F", "%f", "%g", "%G" &
1305 : , "%h", "%H", "%I", "%j", "%m", "%M", "%n", "%p", "%r", "%R", "%S", "%t", "%T" &
1306 : , "%u", "%U", "%V", "%w", "%W", "%x", "%X", "%y", "%Y", "%z", "%Z", "%%" &
1307 : ]
1308 : integer(IKC), allocatable :: Values(:)
1309 : integer :: i, j, k
1310 :
1311 1 : assertion = .true._LK
1312 :
1313 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1314 :
1315 1 : do j = 1, 10
1316 1 : string_ref = SKC_""
1317 1 : string = getDateTime(format = SK_"")
1318 1 : if (string == string_ref) exit
1319 : end do
1320 1 : call report(__LINE__, SK_"@test_getDateTime_2(): An empty format must yield an empty string.")
1321 :
1322 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1323 :
1324 1 : do j = 1, 10
1325 1 : string_ref = SKC_"Today is "//trim(WEEKDAY_NAME(getWeekDay())(1:3))//SKC_"."
1326 1 : string = getDateTime(format = SK_"Today is %a.")
1327 1 : if (string == string_ref) exit
1328 : end do
1329 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %a format must yield a correctly formatted date and time string.")
1330 :
1331 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1332 :
1333 1 : do j = 1, 10
1334 1 : string_ref = SKC_"Today is "//trim(WEEKDAY_NAME(getWeekDay()))//SKC_"."
1335 1 : string = getDateTime(format = SK_"Today is %A.")
1336 1 : if (string == string_ref) exit
1337 : end do
1338 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %A format must yield a correctly formatted date and time string.")
1339 :
1340 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1341 :
1342 1 : do j = 1, 10
1343 1 : string_ref = SKC_"This month is "//trim(MONTH_NAME(getMonth())(1:3))//SKC_"."
1344 1 : string = getDateTime(format = SK_"This month is %b.")
1345 1 : if (string == string_ref) exit
1346 : end do
1347 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %b format must yield a correctly formatted date and time string.")
1348 :
1349 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1350 :
1351 1 : do j = 1, 10
1352 1 : string_ref = SKC_"This month is "//trim(MONTH_NAME(getMonth()))//SKC_"."
1353 1 : string = getDateTime(format = SK_"This month is %B.")
1354 1 : if (string == string_ref) exit
1355 : end do
1356 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %B format must yield a correctly formatted date and time string.")
1357 :
1358 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1359 :
1360 1 : do j = 1, 10
1361 : string_ref = SKC_"The date is "//trim(WEEKDAY_NAME(getWeekDay())(1:3))//SKC_" "//trim(MONTH_NAME(getMonth())(1:3))//SKC_" "//trim(getStr(getDay(), format = SK_"(I0.2)"))//SKC_" "// & ! LCOV_EXCL_LINE
1362 1 : trim(getStr(getHour(), format = SK_"(I0.2)"))//SKC_":"//trim(getStr(getMinute(), format = SK_"(I0.2)"))//SKC_":"//trim(getStr(getSecond(), format = SK_"(I0.2)"))//SKC_" "//getStr(getYear())//SKC_"."
1363 1 : string = getDateTime(format = SK_"The date is %c.")
1364 1 : if (string == string_ref) exit
1365 : end do
1366 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %c format must yield a correctly formatted date and time string.")
1367 :
1368 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1369 :
1370 1 : do j = 1, 10
1371 1 : string_ref = SKC_"This century is "//getStr(floor(getYear() / 100., IKC), signed = .true._LK)//SKC_"."
1372 1 : string = getDateTime(format = SK_"This century is %C.")
1373 1 : if (string == string_ref) exit
1374 : end do
1375 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %C format must yield a correctly formatted date and time string.")
1376 :
1377 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1378 :
1379 1 : do j = 1, 10
1380 1 : string_ref = SKC_"Day of the month is "//getStr(getDay(), format = SK_"(I0.2)")//SKC_"."
1381 1 : string = getDateTime(format = SK_"Day of the month is %d.")
1382 1 : if (string == string_ref) exit
1383 : end do
1384 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %d format must yield a correctly formatted date and time string.")
1385 :
1386 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1387 :
1388 1 : do j = 1, 10
1389 1 : string_ref = SKC_"The short date is "//getDateTime(SKC_"%m/%d/%y")//SKC_"."
1390 1 : string = getDateTime(format = SK_"The short date is %D.")
1391 1 : if (string == string_ref) exit
1392 : end do
1393 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %D format must yield a correctly formatted date and time string.")
1394 :
1395 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1396 :
1397 1 : do j = 1, 10
1398 1 : string_ref = SKC_"Day of the month is "//adjustr(getStr(getDay(), format = SK_"(I2)"))//SKC_"."
1399 1 : string = getDateTime(format = SK_"Day of the month is %e.")
1400 1 : if (string == string_ref) exit
1401 : end do
1402 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %e format must yield a correctly formatted date and time string.")
1403 :
1404 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1405 :
1406 1 : do j = 1, 10
1407 1 : string_ref = SKC_"The short date is "//getDateTime(SKC_"%Y-%m-%d")//SKC_"."
1408 1 : string = getDateTime(format = SK_"The short date is %F.")
1409 1 : if (string == string_ref) exit
1410 : end do
1411 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %F format must yield a correctly formatted date and time string.")
1412 :
1413 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1414 :
1415 1 : do j = 1, 10
1416 2 : Values = getDateTime()
1417 1 : string_ref = SKC_"The millisecond of the second is "//getStr(Values(8), format = SK_"(I3.3)")//SKC_"."
1418 1 : string = getDateTime(format = SK_"The millisecond of the second is %f.", Values = Values)
1419 1 : if (string == string_ref) exit
1420 : end do
1421 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %f format must yield a correctly formatted date and time string.")
1422 :
1423 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1424 :
1425 1 : do j = 1, 10
1426 1 : string_ref = SKC_"The week year is "//getStr(mod(abs(getWeekYear()), 100_IKC), format = SK_"(I0.2)")//SKC_"."
1427 1 : string = getDateTime(format = SK_"The week year is %g.")
1428 1 : if (string == string_ref) exit
1429 : end do
1430 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %g format must yield a correctly formatted date and time string.")
1431 :
1432 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1433 :
1434 1 : do j = 1, 10
1435 1 : string_ref = SKC_"The week year is "//getStr(getWeekYear())//SKC_"."
1436 1 : string = getDateTime(format = SK_"The week year is %G.")
1437 1 : if (string == string_ref) exit
1438 : end do
1439 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %G format must yield a correctly formatted date and time string.")
1440 :
1441 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1442 :
1443 1 : do j = 1, 10
1444 1 : string_ref = SKC_"This month is "//trim(MONTH_NAME(getMonth())(1:3))//SKC_"."
1445 1 : string = getDateTime(format = SK_"This month is %h.")
1446 1 : if (string == string_ref) exit
1447 : end do
1448 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %h format must yield a correctly formatted date and time string.")
1449 :
1450 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1451 :
1452 1 : do j = 1, 10
1453 1 : string_ref = SKC_"The hour is "//trim(getStr(getHour(), format = SK_"(I0.2)"))//SKC_"."
1454 1 : string = getDateTime(format = SK_"The hour is %H.")
1455 1 : if (string == string_ref) exit
1456 : end do
1457 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %H format must yield a correctly formatted date and time string.")
1458 :
1459 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1460 :
1461 1 : do j = 1, 10
1462 1 : string_ref = SKC_"The hour is "//trim(getStr(getHour12(), format = SK_"(I0.2)"))//SKC_"."
1463 1 : string = getDateTime(format = SK_"The hour is %I.")
1464 1 : if (string == string_ref) exit
1465 : end do
1466 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %I format must yield a correctly formatted date and time string.")
1467 :
1468 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1469 :
1470 1 : do j = 1, 10
1471 1 : string_ref = SKC_"The day of year is "//trim(getStr(getOrdinalDay(), format = SK_"(I3.3)"))//SKC_"."
1472 1 : string = getDateTime(format = SK_"The day of year is %j.")
1473 1 : if (string == string_ref) exit
1474 : end do
1475 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %j format must yield a correctly formatted date and time string.")
1476 :
1477 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1478 :
1479 1 : do j = 1, 10
1480 1 : string_ref = SKC_"The month is "//trim(getStr(getMonth(), format = SK_"(I0.2)"))//SKC_"."
1481 1 : string = getDateTime(format = SK_"The month is %m.")
1482 1 : if (string == string_ref) exit
1483 : end do
1484 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %m format must yield a correctly formatted date and time string.")
1485 :
1486 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1487 :
1488 1 : do j = 1, 10
1489 1 : string_ref = SKC_"The minute is "//trim(getStr(getMinute(), format = SK_"(I0.2)"))//SKC_"."
1490 1 : string = getDateTime(format = SK_"The minute is %M.")
1491 1 : if (string == string_ref) exit
1492 : end do
1493 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %M format must yield a correctly formatted date and time string.")
1494 :
1495 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1496 :
1497 1 : do j = 1, 10
1498 1 : string_ref = SKC_"The newline character is "//achar(10, SKC)//SKC_"."
1499 1 : string = getDateTime(format = SK_"The newline character is %n.")
1500 1 : if (string == string_ref) exit
1501 : end do
1502 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %n format must yield a correctly formatted date and time string.")
1503 :
1504 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1505 :
1506 1 : do j = 1, 10
1507 2 : string_ref = SKC_"The designation is "//merge(SKC_"AM", SKC_"PM", isMorning())//SKC_"."
1508 1 : string = getDateTime(format = SK_"The designation is %p.")
1509 1 : if (string == string_ref) exit
1510 : end do
1511 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %p format must yield a correctly formatted date and time string.")
1512 :
1513 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1514 :
1515 1 : do j = 1, 10
1516 2 : string_ref = SKC_"The 12-hour clock time is "//getStr(getHour12(), format = SK_"(I0.2)")//SKC_":"//getStr(getMinute(), format = SK_"(I0.2)")//SKC_":"//getStr(getSecond(), format = SK_"(I0.2)")//SKC_" "//merge(SKC_"am", SKC_"pm", isMorning())//SKC_"."
1517 1 : string = getDateTime(format = SK_"The 12-hour clock time is %r.")
1518 1 : if (string == string_ref) exit
1519 : end do
1520 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %r format must yield a correctly formatted date and time string.")
1521 :
1522 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1523 :
1524 1 : do j = 1, 10
1525 1 : string_ref = SKC_"The 24-hour time is "//getDateTime(SKC_"%H:%M")//SKC_"."
1526 1 : string = getDateTime(format = SK_"The 24-hour time is %R.")
1527 1 : if (string == string_ref) exit
1528 : end do
1529 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %R format must yield a correctly formatted date and time string.")
1530 :
1531 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1532 :
1533 1 : do j = 1, 10
1534 1 : string_ref = SKC_"The second of time is "//getDateTime(getStr(getSecond(), format = SK_"(I0.2)"))//SKC_"."
1535 1 : string = getDateTime(format = SK_"The second of time is %S.")
1536 1 : if (string == string_ref) exit
1537 : end do
1538 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %S format must yield a correctly formatted date and time string.")
1539 :
1540 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1541 :
1542 1 : do j = 1, 10
1543 1 : string_ref = SKC_"The Horizontal-tab character is "//achar(9, SKC)//SKC_"."
1544 1 : string = getDateTime(format = SK_"The Horizontal-tab character is %t.")
1545 1 : if (string == string_ref) exit
1546 : end do
1547 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %t format must yield a correctly formatted date and time string.")
1548 :
1549 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1550 :
1551 1 : do j = 1, 10
1552 1 : string_ref = SKC_"The ISO 8601 time is "//getDateTime(SKC_"%H:%M:%S")//SKC_"."
1553 1 : string = getDateTime(format = SK_"The ISO 8601 time is %T.")
1554 1 : if (string == string_ref) exit
1555 : end do
1556 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %T format must yield a correctly formatted date and time string.")
1557 :
1558 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1559 :
1560 1 : do j = 1, 10
1561 1 : string_ref = SKC_"The ISO 8601 weekday is "//getStr(getWeekDayISO())//SKC_"."
1562 1 : string = getDateTime(format = SK_"The ISO 8601 weekday is %u.")
1563 1 : if (string == string_ref) exit
1564 : end do
1565 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %u format must yield a correctly formatted date and time string.")
1566 :
1567 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1568 :
1569 1 : do j = 1, 10
1570 1 : string_ref = SKC_"The ISO 8601 week number is "//getStr(getWeekNumber(), format = SK_"(I0.2)")//SKC_"."
1571 1 : string = getDateTime(format = SK_"The ISO 8601 week number is %V.")
1572 1 : if (string == string_ref) exit
1573 : end do
1574 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %V format must yield a correctly formatted date and time string.")
1575 :
1576 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1577 :
1578 1 : do j = 1, 10
1579 1 : string_ref = SKC_"The Weekday is "//getStr(getWeekDay())//SKC_"."
1580 1 : string = getDateTime(format = SK_"The Weekday is %w.")
1581 1 : if (string == string_ref) exit
1582 : end do
1583 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %w format must yield a correctly formatted date and time string.")
1584 :
1585 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1586 :
1587 1 : do j = 1, 10
1588 1 : string_ref = getDateTime(SKC_"The current date is %D.")
1589 1 : string = getDateTime(format = SK_"The current date is %x.")
1590 1 : if (string == string_ref) exit
1591 : end do
1592 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %x format must yield a correctly formatted date and time string.")
1593 :
1594 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1595 :
1596 1 : do j = 1, 10
1597 1 : string_ref = getDateTime(SKC_"The current time is %T.")
1598 1 : string = getDateTime(format = SK_"The current time is %X.")
1599 1 : if (string == string_ref) exit
1600 : end do
1601 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %X format must yield a correctly formatted date and time string.")
1602 :
1603 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1604 :
1605 1 : do j = 1, 10
1606 1 : string_ref = SKC_"The year is "//getStr(mod(abs(Values(1)), 100_IKC), format = SK_"(I0.2)")//SKC_"."
1607 1 : string = getDateTime(format = SK_"The year is %y.")
1608 1 : if (string == string_ref) exit
1609 : end do
1610 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %y format must yield a correctly formatted date and time string.")
1611 :
1612 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1613 :
1614 1 : do j = 1, 10
1615 1 : string_ref = SKC_"The year is "//getStr(Values(1), format = SK_"(I0.2)")//SKC_"."
1616 1 : string = getDateTime(format = SK_"The year is %Y.")
1617 1 : if (string == string_ref) exit
1618 : end do
1619 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %Y format must yield a correctly formatted date and time string.")
1620 :
1621 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1622 :
1623 1 : do j = 1, 10
1624 1 : string_ref = SKC_"The zone is "//getStr(Values(4), format = SK_"(sp,I0.4)")//SKC_"."
1625 1 : string = getDateTime(format = SK_"The zone is %z.")
1626 1 : if (string == string_ref) exit
1627 : end do
1628 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %z format must yield a correctly formatted date and time string.")
1629 :
1630 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1631 :
1632 1 : do j = 1, 10
1633 1 : string_ref = SKC_"The zone is "//getStr(Values(4), format = SK_"(sp,I0.4)")//SKC_"."
1634 1 : string = getDateTime(format = SK_"The zone is %z.")
1635 1 : if (string == string_ref) exit
1636 : end do
1637 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %z format must yield a correctly formatted date and time string.")
1638 :
1639 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1640 :
1641 1 : do j = 1, 10
1642 1 : string_ref = SKC_"The percentage is %."
1643 1 : string = getDateTime(format = SK_"The percentage is %%.")
1644 1 : if (string == string_ref) exit
1645 : end do
1646 1 : call report(__LINE__, SK_"@test_getDateTime_2(): The %% format must yield a correctly formatted date and time string.")
1647 :
1648 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1649 :
1650 502 : do i = 1, 500
1651 :
1652 19500 : do j = 1, size(SPECIFIER)
1653 19000 : Values = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
1654 19000 : string_ref = getDateTime_ref(SPECIFIER(j), Values)
1655 19000 : string = getDateTime(SPECIFIER(j), Values)
1656 19500 : call report(__LINE__)
1657 : end do
1658 :
1659 500 : Values = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
1660 500 : j = getUnifRand(1, size(SPECIFIER))
1661 500 : k = getUnifRand(j, size(SPECIFIER))
1662 500 : string_ref = getDateTime_ref(getStr(SPECIFIER(j:k)), Values)
1663 500 : string = getDateTime(getStr(SPECIFIER(j:k)), Values)
1664 500 : call report(__LINE__)
1665 :
1666 500 : Values(1) = getUnifRand(300000_IKC, 300000_IKC)
1667 500 : string_ref = getDateTime_ref(SKC_"%C", Values)
1668 500 : string = getDateTime(SKC_"%C", Values)
1669 501 : call report(__LINE__)
1670 :
1671 : end do
1672 :
1673 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1674 :
1675 : contains
1676 :
1677 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1678 :
1679 20000 : function getDateTime_ref(format, Values) result(string)
1680 :
1681 : #define RESIZE_STRING(LENSEG) \
1682 : eposnew = epos + LENSEG; \
1683 : if (eposnew > lenString) then; \
1684 : if (allocated(tempstr)) deallocate(tempstr); \
1685 : allocate(character(eposnew,SKC) :: tempstr); \
1686 : tempstr(1:lenString) = string; \
1687 : call move_alloc(tempstr, string); \
1688 : lenString = eposnew; \
1689 : end if;
1690 :
1691 : !> \warning
1692 : !> The output of getStr() in this procedure is of kind \SK which is incompatible with any value of SKC /= SK.
1693 : !> For now, this is not an issue since both kinds point to the default character kind.
1694 : !> This will however become an issue once Fortran standard and compilers support non-default date and time characters.
1695 : use pm_val2str, only: getStr
1696 : integer(IK), intent(in), contiguous :: Values(:)
1697 : character(*,SKC), intent(in) :: format
1698 : character(:,SKC), allocatable :: string
1699 : character(:,SKC), allocatable :: tempstr, abbr
1700 : character(9,SKC) :: workspace9
1701 : integer(IK) :: lenString, lenFormat, i, epos, eposnew, lenSeg
1702 : integer(IKC) :: century
1703 20000 : allocate(character(127,SKC) :: string)
1704 20000 : lenFormat = len(format, IK)
1705 : lenString = 127_IK
1706 : eposnew = 0_IK ! the last touched (end) position in the string
1707 : i = 0_IK
1708 : do
1709 53110 : i = i + 1_IK
1710 53110 : if (i > lenFormat) exit
1711 : epos = eposnew
1712 53110 : if (format(i:i) == SKC_"%") then
1713 24370 : if (i == lenFormat) exit
1714 24370 : i = i + 1_IK
1715 24370 : if (format(i:i) == SKC_"a") then ! Abbreviated weekday name *
1716 : lenSeg = 3_IK
1717 506 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1718 506 : string(epos + 1 : eposnew) = WEEKDAY_NAME_ISO(getWeekDayISO(Values(1), Values(2), Values(3)))(1:lenSeg)
1719 : elseif (format(i:i) == SKC_"A") then ! Full weekday name *
1720 512 : workspace9 = WEEKDAY_NAME_ISO(getWeekDayISO(Values(1), Values(2), Values(3)))
1721 512 : lenSeg = len_trim(workspace9, IKC)
1722 512 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1723 512 : string(epos + 1 : eposnew) = workspace9(1:lenSeg)
1724 : elseif (format(i:i) == SKC_"b" .or. format(i:i) == SKC_"h") then ! Abbreviated month name * .or. Abbreviated month name * (same as %b)
1725 : lenSeg = 3_IK
1726 1151 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1727 1151 : string(epos + 1 : eposnew) = MONTH_NAME(Values(2))(1:lenSeg)
1728 : elseif (format(i:i) == SKC_"B") then ! Full month name *
1729 533 : lenSeg = len_trim(MONTH_NAME(Values(2)), IKC)
1730 533 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1731 533 : string(epos + 1 : eposnew) = MONTH_NAME(Values(2))(1:lenSeg)
1732 : elseif (format(i:i) == SKC_"c") then ! Date and time representation *
1733 541 : if (Values(1) > 0_IKC) then
1734 0 : RESIZE_STRING(24_IK) ! fpp sets eposnew, and resizes string.
1735 : else
1736 541 : RESIZE_STRING(25_IK) ! fpp sets eposnew, and resizes string.
1737 : end if
1738 : string(epos + 1 : eposnew) = WEEKDAY_NAME_ISO(getWeekDayISO(Values(1), Values(2), Values(3)))(1:3)//SKC_" "// & ! LCOV_EXCL_LINE
1739 : MONTH_NAME(Values(2))(1:3)//SKC_" "// & ! LCOV_EXCL_LINE
1740 : getStr(Values(3), length = 2_IK, format = "(1I0.2)")//SKC_" "// & ! LCOV_EXCL_LINE
1741 : getStr(Values(5), length = 2_IK, format = "(1I0.2)")//SKC_":"// & ! LCOV_EXCL_LINE
1742 : getStr(Values(6), length = 2_IK, format = "(1I0.2)")//SKC_":"// & ! LCOV_EXCL_LINE
1743 : getStr(Values(7), length = 2_IK, format = "(1I0.2)")//SKC_" "// & ! LCOV_EXCL_LINE
1744 541 : getStr(Values(1))
1745 : elseif (format(i:i) == SKC_"C") then ! Year divided by 100 and truncated to integer (00-99). \warning it works for years up to 9 digits.
1746 1050 : century = floor(Values(1) / 100., IKC)
1747 1050 : if (abs(century) < 100_IKC) then
1748 : !write(workspace9(1:3), "(sp,I0.2)") century
1749 550 : RESIZE_STRING(3_IK) ! fpp sets eposnew, and resizes string.
1750 550 : write(string(epos + 1 : eposnew), "(sp,I0.2)") century
1751 : else
1752 500 : workspace9 = getStr(century)
1753 500 : lenSeg = len_trim(workspace9, IKC)
1754 500 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1755 500 : string(epos + 1 : eposnew) = workspace9(1:lenSeg)
1756 : end if
1757 : elseif (format(i:i) == SKC_"d") then ! Day of the month, zero-padded (01-31).
1758 562 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1759 562 : write(string(epos + 1 : eposnew), "(I0.2)") Values(3)
1760 : elseif (format(i:i) == SKC_"D") then ! Short MM/DD/YY date, equivalent to %m/%d/%y
1761 574 : RESIZE_STRING(8_IK) ! fpp sets eposnew, and resizes string.
1762 574 : write(string(epos + 1 : eposnew), "(I0.2,'/',I0.2,'/',I0.2)") Values(2:3), mod(abs(Values(1)), 100_IKC) ! last two digits of year.
1763 : elseif (format(i:i) == SKC_"e") then ! Day of the month, zero-padded (01-31).
1764 589 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1765 589 : write(string(epos + 1 : eposnew), "(I2)") Values(3)
1766 : elseif (format(i:i) == SKC_"f") then ! millisecond padded with leading zeros
1767 607 : RESIZE_STRING(3_IK) ! fpp sets eposnew, and resizes string.
1768 607 : write(string(epos + 1 : eposnew), "(I0.3)") Values(8)
1769 : elseif (format(i:i) == SKC_"F") then ! Short YYYY-MM-DD date, equivalent to %Y-%m-%d
1770 604 : if (Values(1) > 0_IKC) then
1771 0 : RESIZE_STRING(10_IK) ! fpp sets eposnew, and resizes string.
1772 : else
1773 604 : RESIZE_STRING(11_IK) ! fpp sets eposnew, and resizes string.
1774 : end if
1775 604 : write(string(epos + 1 : eposnew), "(I0.2,'-',I0.2,'-',I0.2)") Values(1:3)
1776 : elseif (format(i:i) == SKC_"g") then ! Week-based year, last two digits (00-99).
1777 617 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1778 617 : write(string(epos + 1 : eposnew), "(I0.2)") mod(abs(getWeekYear(Values(1:3))), 100_IKC) ! last two digits of the week year.
1779 : elseif (format(i:i) == SKC_"G") then ! Week-based year, full week year, possibly negative.
1780 622 : workspace9 = getStr(getWeekYear(Values(1:3))) ! WeekDate(1)) ! full week year, possibly negative.
1781 622 : lenSeg = len_trim(workspace9, IKC)
1782 622 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1783 622 : string(epos + 1 : eposnew) = workspace9(1:lenSeg)
1784 : elseif (format(i:i) == SKC_"H") then ! Hour in 24h format (00-23)
1785 638 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1786 638 : write(string(epos + 1 : eposnew), "(I0.2)") Values(5)
1787 : elseif (format(i:i) == SKC_"I") then ! Hour in 12h format (01-12)
1788 647 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1789 647 : write(string(epos + 1 : eposnew), "(I0.2)") getHour12(Values(5))
1790 : elseif (format(i:i) == SKC_"j") then ! Day of the year (001-366)
1791 659 : RESIZE_STRING(3_IK) ! fpp sets eposnew, and resizes string.
1792 659 : write(string(epos + 1 : eposnew), "(I0.3)") getOrdinalDay(Values(1:3))
1793 : elseif (format(i:i) == SKC_"m") then ! Month as a decimal number (01-12)
1794 663 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1795 663 : write(string(epos + 1 : eposnew), "(I0.2)") Values(2)
1796 : elseif (format(i:i) == SKC_"M") then ! Minute (00-59)
1797 666 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1798 666 : write(string(epos + 1 : eposnew), "(I0.2)") Values(6)
1799 : elseif (format(i:i) == SKC_"n") then ! New-line character ('\n')
1800 672 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1801 672 : string(epos + 1 : eposnew) = achar(10, SKC) ! new_line(SKC_"a")
1802 : elseif (format(i:i) == SKC_"p") then ! New-line character ('\n')
1803 675 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1804 675 : if (Values(5) < 12_IKC) then
1805 338 : string(epos + 1 : eposnew) = SKC_"AM"
1806 : else
1807 337 : string(epos + 1 : eposnew) = SKC_"PM"
1808 : end if
1809 : elseif (format(i:i) == SKC_"r") then ! 12-hour clock time *
1810 687 : RESIZE_STRING(11_IK) ! fpp sets eposnew, and resizes string.
1811 687 : if (Values(5) < 12_IKC) then
1812 333 : write(string(epos + 1 : eposnew), "(I0.2,':',I0.2,':',I0.2,' am')") getHour12(Values(5)), Values(6:7)
1813 : else
1814 354 : write(string(epos + 1 : eposnew), "(I0.2,':',I0.2,':',I0.2,' pm')") getHour12(Values(5)), Values(6:7)
1815 : end if
1816 : elseif (format(i:i) == SKC_"R") then ! 24-hour HH:MM time, equivalent to %H:%M
1817 685 : RESIZE_STRING(5_IK) ! fpp sets eposnew, and resizes string.
1818 685 : write(string(epos + 1 : eposnew), "(I0.2,':',I0.2)") Values(5:6)
1819 : elseif (format(i:i) == SKC_"S") then ! Second (00-59)
1820 689 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1821 689 : write(string(epos + 1 : eposnew), "(I0.2)") Values(7)
1822 : elseif (format(i:i) == SKC_"t") then ! Horizontal-tab character ('\t')
1823 684 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1824 684 : string(epos + 1 : eposnew) = achar(9, SKC)
1825 : elseif (format(i:i) == SKC_"T") then ! ISO 8601 time format (HH:MM:SS), equivalent to %H:%M:%S
1826 692 : RESIZE_STRING(8_IK) ! fpp sets eposnew, and resizes string.
1827 692 : write(string(epos + 1 : eposnew), "(I0.2,':',I0.2,':',I0.2)") Values(5:7)
1828 : elseif (format(i:i) == SKC_"u") then ! ISO 8601 weekday as number with Monday as 1 (1-7)
1829 690 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1830 690 : write(string(epos + 1 : eposnew), "(I1)") getWeekDayISO(Values(1), Values(2), Values(3))
1831 : elseif (format(i:i) == SKC_"V") then ! ISO 8601 week number (01-53)
1832 690 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1833 690 : write(string(epos + 1 : eposnew), "(I0.2)") getWeekNumber(Values(1), Values(2), Values(3))
1834 : elseif (format(i:i) == SKC_"w") then ! Weekday as a decimal number with Sunday as 0 (0-6)
1835 687 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1836 687 : write(string(epos + 1 : eposnew), "(I1)") getWeekDay(Values(1), Values(2), Values(3))
1837 : elseif (format(i:i) == SKC_"x") then ! Date representation *
1838 679 : RESIZE_STRING(8_IK) ! fpp sets eposnew, and resizes string.
1839 679 : write(string(epos + 1 : eposnew), "(I0.2,'/',I0.2,'/',I0.2)") Values(2), Values(3), mod(abs(Values(1)), 100_IKC) ! last two digits of year.
1840 : elseif (format(i:i) == SKC_"X") then ! Time representation *
1841 667 : RESIZE_STRING(8_IK) ! fpp sets eposnew, and resizes string.
1842 667 : write(string(epos + 1 : eposnew), "(I0.2,':',I0.2,':',I0.2)") Values(5:7)
1843 : elseif (format(i:i) == SKC_"y") then ! Year, last two digits (00-99)
1844 642 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1845 642 : write(string(epos + 1 : eposnew), "(I0.2)") mod(abs(Values(1)), 100_IKC) ! last two digits of year.
1846 : elseif (format(i:i) == SKC_"Y") then ! Year, last two digits (00-99)
1847 639 : workspace9 = getStr(Values(1))
1848 639 : lenSeg = len_trim(workspace9, IKC)
1849 639 : RESIZE_STRING(lenSeg) ! fpp sets eposnew, and resizes string.
1850 639 : string(epos + 1 : eposnew) = workspace9(1:lenSeg)
1851 : elseif (format(i:i) == SKC_"z") then ! ISO 8601 offset from UTC in timezone in units of minutes
1852 619 : RESIZE_STRING(5_IK) ! fpp sets eposnew, and resizes string.
1853 619 : write(string(epos + 1 : eposnew), "(sp,I0.4)") Values(4)
1854 : elseif (format(i:i) == SKC_"Z") then ! Timezone name or abbreviation.
1855 602 : abbr = getZoneAbbr(Values(4))
1856 602 : RESIZE_STRING(len(abbr, IK))
1857 602 : string(epos + 1 : eposnew) = abbr
1858 : elseif (format(i:i) == SKC_"%") then ! add percentage.
1859 552 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1860 552 : string(epos + 1 : eposnew) = SKC_"%"
1861 : else ! Unrecognized format.
1862 1378 : RESIZE_STRING(2_IK) ! fpp sets eposnew, and resizes string.
1863 1378 : string(epos + 1 : eposnew) = format(i - 1 : i)
1864 : end if
1865 : else ! normal characters.
1866 8740 : RESIZE_STRING(1_IK) ! fpp sets eposnew, and resizes string.
1867 8740 : string(epos + 1 : eposnew) = format(i : i)
1868 : end if
1869 : end do
1870 20000 : if (lenString > eposnew) then
1871 19951 : tempstr = string(1:eposnew)
1872 19951 : call move_alloc(tempstr, string)
1873 : end if
1874 :
1875 : #undef RESIZE_STRING
1876 :
1877 20000 : end function
1878 :
1879 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1880 :
1881 20037 : subroutine report(line, msg)
1882 : use pm_option, only: getOption
1883 : integer, intent(in) :: line
1884 : character(*,SKC), intent(in), optional :: msg
1885 : character(:,SKC), allocatable :: msg_def
1886 20037 : assertion = assertion .and. logical(string == string_ref, LK)
1887 20037 : if (test%traceable .and. .not. assertion) then
1888 : ! LCOV_EXCL_START
1889 : write(test%disp%unit,"(*(g0,:,', '))")
1890 : write(test%disp%unit,"(*(g0,:,', '))") "string ", string
1891 : write(test%disp%unit,"(*(g0,:,', '))") "string_ref ", string_ref
1892 : write(test%disp%unit,"(*(g0,:,', '))") "len(string, IK) ", len(string, IK)
1893 : write(test%disp%unit,"(*(g0,:,', '))") "len(string_ref, IK)", len(string_ref, IK)
1894 : write(test%disp%unit,"(*(g0,:,', '))")
1895 : ! LCOV_EXCL_STOP
1896 : end if
1897 20037 : if (present(msg)) then
1898 37 : msg_def = msg
1899 : else
1900 20000 : msg_def = SKC_"@test_getDateTimeNewZone(): The output datetime string must have the correct format."
1901 : end if
1902 20037 : call test%assert(assertion, msg_def, int(line, IK))
1903 20037 : assertion = assertion .and. logical(len(string, IK) == len(string_ref, IK), LK)
1904 20037 : call test%assert(assertion, SK_"@test_getDateTimeNewZone(): The output datetime string must have the correct length.", int(line, IK))
1905 40074 : end subroutine
1906 :
1907 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1908 :
1909 : end procedure
1910 :
1911 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1912 :
1913 1 : module procedure test_getWeekDate
1914 :
1915 : use pm_distUnif, only: getUnifRand
1916 : use pm_kind, only: SKC => SK, IKC => IK
1917 : integer(IKC), allocatable :: Values(:), WeekDate(:), WeekDate_ref(:)
1918 : integer :: i
1919 1 : assertion = .true._LK
1920 :
1921 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1922 :
1923 5 : Values = int([1977_IK, 1_IK, 1_IK], IKC)
1924 5 : WeekDate_ref = int([+1976, +53, +6], IKC)
1925 1 : call runTests(__LINE__)
1926 :
1927 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1928 :
1929 5 : Values = int([1977_IK, 1_IK, 2_IK], IKC)
1930 5 : WeekDate_ref = int([+1976, +53, +7], IKC)
1931 1 : call runTests(__LINE__)
1932 :
1933 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1934 :
1935 5 : Values = int([1977_IK, 12_IK, 31_IK], IKC)
1936 5 : WeekDate_ref = int([+1977, +52, +6], IKC)
1937 1 : call runTests(__LINE__)
1938 :
1939 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1940 :
1941 5 : Values = int([1978_IK, 1_IK, 1_IK], IKC)
1942 5 : WeekDate_ref = int([+1977, +52, +7], IKC)
1943 1 : call runTests(__LINE__)
1944 :
1945 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1946 :
1947 5 : Values = int([1978_IK, 1_IK, 2_IK], IKC)
1948 5 : WeekDate_ref = int([+1978, +1, +1], IKC)
1949 1 : call runTests(__LINE__)
1950 :
1951 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1952 :
1953 5 : Values = int([1978_IK, 12_IK, 31_IK], IKC)
1954 5 : WeekDate_ref = int([+1978, +52, +7], IKC)
1955 1 : call runTests(__LINE__)
1956 :
1957 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1958 :
1959 5 : Values = int([1979_IK, 1_IK, 1_IK], IKC)
1960 5 : WeekDate_ref = int([+1979, +1, +1], IKC)
1961 1 : call runTests(__LINE__)
1962 :
1963 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1964 :
1965 5 : Values = int([1979_IK, 12_IK, 30_IK], IKC)
1966 5 : WeekDate_ref = int([+1979, +52, +7], IKC)
1967 1 : call runTests(__LINE__)
1968 :
1969 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1970 :
1971 5 : Values = int([1979_IK, 12_IK, 31_IK], IKC)
1972 5 : WeekDate_ref = int([+1980, +1, +1], IKC)
1973 1 : call runTests(__LINE__)
1974 :
1975 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1976 :
1977 1 : do i = 1, 10
1978 10 : Values = getDateTime()
1979 5 : WeekDate = getWeekDate()
1980 5 : WeekDate_ref = getWeekDate(Values(1:3))
1981 4 : if (all(WeekDate == WeekDate_ref)) exit
1982 : end do
1983 1 : call report(__LINE__, SK_"@test_getWeekDate(): Calling `getWeekDate()` without arguments must yield the current week date.")
1984 :
1985 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1986 :
1987 : contains
1988 :
1989 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1990 :
1991 9 : subroutine runTests(line)
1992 : integer, intent(in) :: line
1993 45 : WeekDate = getWeekDate(Values)
1994 9 : call report(line, SK_"@test_getWeekDate(): Calling `getWeekDate(Values(1:3))` must yield the current week date.")
1995 45 : WeekDate = getWeekDate(Values(1), Values(2), Values(3))
1996 9 : call report(line, SK_"@test_getWeekDate(): Calling `getWeekDate(Values(1), Values(2), Values(3))` must yield the current week date.")
1997 9 : end subroutine
1998 :
1999 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2000 :
2001 19 : subroutine report(line, msg)
2002 : use pm_option, only: getOption
2003 : integer, intent(in) :: line
2004 : character(*,SKC), intent(in), optional :: msg
2005 : character(:,SKC), allocatable :: msg_def
2006 19 : assertion = assertion .and. logical(size(WeekDate, 1, IK) == size(WeekDate_ref, 1, IK), LK)
2007 19 : call test%assert(assertion, SK_"@test_getWeekDate(): The output week date vector must have the correct length.", int(line, IK))
2008 76 : assertion = assertion .and. logical(all(WeekDate == WeekDate_ref), LK)
2009 19 : if (test%traceable .and. .not. assertion) then
2010 : ! LCOV_EXCL_START
2011 : write(test%disp%unit,"(*(g0,:,', '))")
2012 : write(test%disp%unit,"(*(g0,:,', '))") "WeekDate ", WeekDate
2013 : write(test%disp%unit,"(*(g0,:,', '))") "WeekDate_ref ", WeekDate_ref
2014 : write(test%disp%unit,"(*(g0,:,', '))") "size(WeekDate, IK) ", size(WeekDate, 1, IK)
2015 : write(test%disp%unit,"(*(g0,:,', '))") "size(WeekDate_ref, IK) ", size(WeekDate_ref, 1, IK)
2016 : write(test%disp%unit,"(*(g0,:,', '))")
2017 : ! LCOV_EXCL_STOP
2018 : end if
2019 19 : if (present(msg)) then
2020 19 : msg_def = msg
2021 : else
2022 0 : msg_def = SKC_"@test_getWeekDate(): The output week date vector must be correct."
2023 : end if
2024 19 : call test%assert(assertion, msg_def, int(line, IK))
2025 38 : end subroutine
2026 :
2027 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2028 :
2029 : end procedure
2030 :
2031 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2032 :
2033 1 : module procedure test_getWeekYear
2034 :
2035 : use pm_distUnif, only: getUnifRand
2036 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK
2037 : integer(IKC) :: weekYear, weekYear_ref
2038 : integer(IKC) :: WeekDate(3), Values(8)
2039 : integer :: i
2040 1 : assertion = .true._LK
2041 :
2042 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2043 :
2044 1 : weekYear = getWeekYear()
2045 1 : WeekDate = getWeekDate()
2046 1 : weekYear_ref = WeekDate(1)
2047 1 : call report(__LINE__)
2048 :
2049 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2050 :
2051 201 : do i = 1, 200
2052 :
2053 200 : Values = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2054 200 : WeekDate = getWeekDate(Values(1:3))
2055 200 : weekYear_ref = WeekDate(1)
2056 :
2057 200 : weekYear = getWeekYear(Values(1:3))
2058 200 : call report(__LINE__)
2059 :
2060 200 : weekYear = getWeekYear(Values(1), Values(2), Values(3))
2061 201 : call report(__LINE__)
2062 :
2063 : end do
2064 :
2065 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2066 :
2067 : contains
2068 :
2069 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2070 :
2071 401 : subroutine report(line, msg)
2072 : use pm_option, only: getOption
2073 : integer, intent(in) :: line
2074 : character(*,SKC), intent(in), optional :: msg
2075 401 : assertion = assertion .and. logical(weekYear == weekYear_ref, LK)
2076 401 : if (test%traceable .and. .not. assertion) then
2077 : ! LCOV_EXCL_START
2078 : write(test%disp%unit,"(*(g0,:,', '))")
2079 : write(test%disp%unit,"(*(g0,:,', '))") "weekYear ", weekYear
2080 : write(test%disp%unit,"(*(g0,:,', '))") "weekYear_ref ", weekYear_ref
2081 : write(test%disp%unit,"(*(g0,:,', '))")
2082 : ! LCOV_EXCL_STOP
2083 : end if
2084 1203 : call test%assert(assertion, getOption(SK_"@test_getWeekYear(): The output week year must be correct.", msg), int(line, IK))
2085 401 : end subroutine
2086 :
2087 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2088 :
2089 : end procedure
2090 :
2091 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2092 :
2093 1 : module procedure test_isValidDateTime
2094 :
2095 : use pm_distUnif, only: getUnifRand
2096 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2097 : logical(LKC) :: isValid, isValid_ref
2098 : integer(IKC) :: Values(10)
2099 : integer :: i, j
2100 1 : assertion = .true._LK
2101 :
2102 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2103 :
2104 1 : isValid_ref = .false._LKC
2105 1 : isValid = isValidDateTime(Values(2:1))
2106 1 : call report(__LINE__)
2107 :
2108 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2109 :
2110 1 : isValid_ref = .false._LKC
2111 1 : isValid = isValidDateTime(Values(1:10))
2112 1 : call report(__LINE__)
2113 :
2114 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2115 :
2116 1 : isValid_ref = .false._LKC
2117 1 : isValid = isValidDateTime(Values(1:9))
2118 1 : call report(__LINE__)
2119 :
2120 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2121 :
2122 201 : do i = 1, 200
2123 :
2124 1800 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2125 :
2126 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3), Values(4), Values(5), Values(6), Values(7), Values(8))
2127 200 : isValid_ref = isValidDateTime_ref(Values(1:8))
2128 200 : call report(__LINE__)
2129 :
2130 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3), Values(4), Values(5), Values(6), Values(7))
2131 200 : isValid_ref = isValidDateTime_ref(Values(1:7))
2132 200 : call report(__LINE__)
2133 :
2134 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3), Values(4), Values(5), Values(6))
2135 200 : isValid_ref = isValidDateTime_ref(Values(1:6))
2136 200 : call report(__LINE__)
2137 :
2138 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3), Values(4), Values(5))
2139 200 : isValid_ref = isValidDateTime_ref(Values(1:5))
2140 200 : call report(__LINE__)
2141 :
2142 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3), Values(4))
2143 200 : isValid_ref = isValidDateTime_ref(Values(1:4))
2144 200 : call report(__LINE__)
2145 :
2146 200 : isValid = isValidDateTime(Values(1), Values(2), Values(3))
2147 200 : isValid_ref = isValidDateTime_ref(Values(1:3))
2148 200 : call report(__LINE__)
2149 :
2150 200 : isValid = isValidDateTime(Values(1), Values(2))
2151 200 : isValid_ref = isValidDateTime_ref(Values(1:2))
2152 200 : call report(__LINE__)
2153 :
2154 200 : isValid = isValidDateTime(Values(1))
2155 200 : isValid_ref = isValidDateTime_ref(Values(1:1))
2156 200 : call report(__LINE__)
2157 :
2158 2401 : do j = 0, 10
2159 2200 : isValid = isValidDateTime(Values(1:j))
2160 2200 : isValid_ref = isValidDateTime_ref(Values(1:j))
2161 2400 : call report(__LINE__)
2162 : end do
2163 :
2164 : end do
2165 :
2166 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2167 :
2168 : contains
2169 :
2170 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2171 :
2172 3800 : function isValidDateTime_ref(Values) result(isValid)
2173 : integer(IKC), intent(in), contiguous :: Values(:)
2174 : logical(LKC) :: isValid
2175 3800 : isValid = 0 < size(Values) .and. size(Values) < 9
2176 3800 : if (isValid .and. size(Values) > 1) then
2177 2800 : isValid = 0_IKC < Values(2) .and. Values(2) < 13_IKC
2178 2800 : if (isValid .and. size(Values) > 2) then
2179 2400 : if (isLeapYear(Values(1))) then
2180 564 : isValid = 0_IKC < Values(3) .and. Values(3) <= DAYS_OF_MONTH_LEAP(Values(2))
2181 : else
2182 1836 : isValid = 0_IKC < Values(3) .and. Values(3) <= DAYS_OF_MONTH(Values(2))
2183 : end if
2184 2400 : if (isValid .and. size(Values) > 3) then
2185 2000 : isValid = int(ZONE_MIN, IKC) <= Values(4) .and. Values(4) < int(ZONE_MAX, IKC)
2186 2000 : if (isValid .and. size(Values) > 4) then
2187 1600 : isValid = 0_IKC <= Values(5) .and. Values(5) < 24_IKC
2188 1600 : if (isValid .and. size(Values) > 5) then
2189 1200 : isValid = 0_IKC <= Values(6) .and. Values(6) < 60_IKC
2190 1200 : if (isValid .and. size(Values) > 6) then
2191 800 : isValid = 0_IKC <= Values(7) .and. Values(7) < 60_IKC
2192 800 : if (isValid .and. size(Values) > 7) isValid = 0_IKC <= Values(8) .and. Values(8) < 1000_IKC
2193 : end if
2194 : end if
2195 : end if
2196 : end if
2197 : end if
2198 : end if
2199 3800 : end function
2200 :
2201 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2202 :
2203 3803 : subroutine report(line, msg)
2204 : use pm_option, only: getOption
2205 : integer, intent(in) :: line
2206 : character(*,SKC), intent(in), optional :: msg
2207 3803 : assertion = assertion .and. logical(isValid .eqv. isValid_ref, LK)
2208 3803 : if (test%traceable .and. .not. assertion) then
2209 : ! LCOV_EXCL_START
2210 : write(test%disp%unit,"(*(g0,:,', '))")
2211 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2212 : write(test%disp%unit,"(*(g0,:,', '))") "size(Values) ", size(Values)
2213 : write(test%disp%unit,"(*(g0,:,', '))") "isValid ", isValid
2214 : write(test%disp%unit,"(*(g0,:,', '))") "isValid_ref ", isValid_ref
2215 : write(test%disp%unit,"(*(g0,:,', '))")
2216 : ! LCOV_EXCL_STOP
2217 : end if
2218 11409 : call test%assert(assertion, getOption(SK_"@test_isValidDateTime(): The procedure must correctly recognize valid and invalid date and time.", msg), int(line, IK))
2219 3803 : end subroutine
2220 :
2221 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2222 :
2223 : end procedure
2224 :
2225 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2226 :
2227 1 : module procedure test_isLastDayInMonth
2228 :
2229 : use pm_distUnif, only: getUnifRand
2230 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2231 : integer(IKC) :: Values(8), DateAfter(3)
2232 : logical(LKC) :: isLast, isLast_ref
2233 : integer :: i
2234 1 : assertion = .true._LK
2235 :
2236 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2237 :
2238 1 : do i = 1, 10
2239 9 : Values = getDateTime()
2240 1 : isLast = isLastDayInMonth()
2241 1 : isLast_ref = isLastDayInMonth(Values)
2242 1 : if (isLast .eqv. isLast_ref) exit
2243 : end do
2244 1 : call report(__LINE__)
2245 :
2246 :
2247 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2248 :
2249 10001 : do i = 1, 10000
2250 :
2251 90000 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2252 10000 : DateAfter(1:3) = getDateAfter(Values(1:3))
2253 10000 : isLast_ref = logical(DateAfter(2) /= Values(2), LK)
2254 :
2255 10000 : isLast = isLastDayInMonth(Values(1), Values(2), Values(3))
2256 10000 : call report(__LINE__)
2257 :
2258 10000 : isLast = isLastDayInMonth(Values(1), Values(2), Values(3))
2259 10001 : call report(__LINE__)
2260 :
2261 : end do
2262 :
2263 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2264 :
2265 : contains
2266 :
2267 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2268 :
2269 20001 : subroutine report(line, msg)
2270 : use pm_option, only: getOption
2271 : integer, intent(in) :: line
2272 : character(*,SKC), intent(in), optional :: msg
2273 20001 : assertion = assertion .and. logical(isLast .eqv. isLast_ref, LK)
2274 20001 : if (test%traceable .and. .not. assertion) then
2275 : ! LCOV_EXCL_START
2276 : write(test%disp%unit,"(*(g0,:,', '))")
2277 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2278 : write(test%disp%unit,"(*(g0,:,', '))") "isLast_ref ", isLast_ref
2279 : write(test%disp%unit,"(*(g0,:,', '))") "isLast ", isLast
2280 : write(test%disp%unit,"(*(g0,:,', '))")
2281 : ! LCOV_EXCL_STOP
2282 : end if
2283 60003 : call test%assert(assertion, getOption(SK_"@test_isLastDayInMonth(): The procedure must correctly recognize if input date and time is the last day of the month.", msg), int(line, IK))
2284 20001 : end subroutine
2285 :
2286 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2287 :
2288 : end procedure
2289 :
2290 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2291 :
2292 1 : module procedure test_getDateAfter
2293 :
2294 : use pm_distUnif, only: getUnifRand
2295 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2296 : integer(IKC) :: Values(8), DateBefore(3), DateAfter(3), DateAfter_ref(3)
2297 : integer :: i
2298 1 : assertion = .true._LK
2299 :
2300 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2301 :
2302 10001 : do i = 1, 10000
2303 :
2304 10000 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2305 40000 : DateAfter_ref(1:3) = Values(1:3)
2306 10000 : DateBefore = getDateBefore(DateAfter_ref)
2307 :
2308 40000 : DateAfter(1:3) = getDateAfter(DateBefore(1:3))
2309 10000 : call report(__LINE__)
2310 :
2311 40000 : DateAfter(1:3) = getDateAfter(DateBefore(1), DateBefore(2), DateBefore(3))
2312 10001 : call report(__LINE__)
2313 :
2314 : end do
2315 :
2316 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2317 :
2318 1 : do i = 1, 10
2319 4 : DateAfter = getDateAfter()
2320 4 : DateAfter_ref = getDateAfter(getDateTime())
2321 4 : if (all(DateAfter == DateAfter_ref)) exit
2322 : end do
2323 1 : call report(__LINE__)
2324 :
2325 :
2326 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2327 :
2328 : contains
2329 :
2330 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2331 :
2332 20001 : subroutine report(line, msg)
2333 : use pm_option, only: getOption
2334 : integer, intent(in) :: line
2335 : character(*,SKC), intent(in), optional :: msg
2336 80004 : assertion = assertion .and. logical(all(DateAfter == DateAfter_ref), LK)
2337 20001 : if (test%traceable .and. .not. assertion) then
2338 : ! LCOV_EXCL_START
2339 : write(test%disp%unit,"(*(g0,:,', '))")
2340 : write(test%disp%unit,"(*(g0,:,', '))") "DateAfter ", DateAfter
2341 : write(test%disp%unit,"(*(g0,:,', '))") "DateAfter_ref ", DateAfter_ref
2342 : write(test%disp%unit,"(*(g0,:,', '))")
2343 : ! LCOV_EXCL_STOP
2344 : end if
2345 60003 : call test%assert(assertion, getOption(SK_"@test_getDateAfter(): The procedure must correctly compute the date after the specified or the current date.", msg), int(line, IK))
2346 20001 : end subroutine
2347 :
2348 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2349 :
2350 : end procedure
2351 :
2352 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2353 :
2354 1 : module procedure test_getDateBefore
2355 :
2356 : use pm_distUnif, only: getUnifRand
2357 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2358 : integer(IKC) :: Values(8), DateAfter(3), DateBefore(3), DateBefore_ref(3)
2359 : integer :: i
2360 1 : assertion = .true._LK
2361 :
2362 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2363 :
2364 10001 : do i = 1, 10000
2365 :
2366 10000 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2367 40000 : DateBefore_ref(1:3) = Values(1:3)
2368 10000 : DateAfter = getDateAfter(DateBefore_ref)
2369 :
2370 40000 : DateBefore(1:3) = getDateBefore(DateAfter(1:3))
2371 10000 : call report(__LINE__)
2372 :
2373 40000 : DateBefore(1:3) = getDateBefore(DateAfter(1), DateAfter(2), DateAfter(3))
2374 10001 : call report(__LINE__)
2375 :
2376 : end do
2377 :
2378 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2379 :
2380 1 : do i = 1, 10
2381 4 : DateBefore = getDateBefore()
2382 4 : DateBefore_ref = getDateBefore(getDateTime())
2383 4 : if (all(DateBefore == DateBefore_ref)) exit
2384 : end do
2385 1 : call report(__LINE__)
2386 :
2387 :
2388 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2389 :
2390 : contains
2391 :
2392 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2393 :
2394 20001 : subroutine report(line, msg)
2395 : use pm_option, only: getOption
2396 : integer, intent(in) :: line
2397 : character(*,SKC), intent(in), optional :: msg
2398 80004 : assertion = assertion .and. logical(all(DateBefore == DateBefore_ref), LK)
2399 20001 : if (test%traceable .and. .not. assertion) then
2400 : ! LCOV_EXCL_START
2401 : write(test%disp%unit,"(*(g0,:,', '))")
2402 : write(test%disp%unit,"(*(g0,:,', '))") "DateBefore ", DateBefore
2403 : write(test%disp%unit,"(*(g0,:,', '))") "DateBefore_ref ", DateBefore_ref
2404 : write(test%disp%unit,"(*(g0,:,', '))")
2405 : ! LCOV_EXCL_STOP
2406 : end if
2407 60003 : call test%assert(assertion, getOption(SK_"@test_getDateBefore(): The procedure must correctly compute the date after the specified or the current date.", msg), int(line, IK))
2408 20001 : end subroutine
2409 :
2410 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2411 :
2412 : end procedure
2413 :
2414 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2415 :
2416 1 : module procedure test_getOrdinalDay
2417 :
2418 : use pm_distUnif, only: getUnifRand
2419 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2420 : integer(IKC) :: Values(8), ordinalDay, ordinalDay_ref
2421 : integer :: i
2422 1 : assertion = .true._LK
2423 :
2424 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2425 :
2426 10001 : do i = 1, 10000
2427 :
2428 10000 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2429 10000 : ordinalDay_ref = floor(getDateTimeDiff(Values, getDateTime(Values(1))), IKC) + 1_IKC
2430 :
2431 10000 : ordinalDay = getordinalDay(Values)
2432 10000 : call report(__LINE__)
2433 :
2434 10000 : ordinalDay = getordinalDay(Values(1), Values(2), Values(3))
2435 10001 : call report(__LINE__)
2436 :
2437 : end do
2438 :
2439 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2440 :
2441 1 : do i = 1, 10
2442 1 : ordinalDay = getOrdinalDay()
2443 1 : ordinalDay_ref = getOrdinalDay(getDateTime())
2444 1 : if (ordinalDay == ordinalDay_ref) exit
2445 : end do
2446 1 : call report(__LINE__)
2447 :
2448 :
2449 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2450 :
2451 : contains
2452 :
2453 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2454 :
2455 20001 : subroutine report(line, msg)
2456 : use pm_option, only: getOption
2457 : integer, intent(in) :: line
2458 : character(*,SKC), intent(in), optional :: msg
2459 20001 : assertion = assertion .and. logical(ordinalDay == ordinalDay_ref, LK)
2460 20001 : if (test%traceable .and. .not. assertion) then
2461 : ! LCOV_EXCL_START
2462 : write(test%disp%unit,"(*(g0,:,', '))")
2463 : write(test%disp%unit,"(*(g0,:,', '))") "ordinalDay ", ordinalDay
2464 : write(test%disp%unit,"(*(g0,:,', '))") "ordinalDay_ref ", ordinalDay_ref
2465 : write(test%disp%unit,"(*(g0,:,', '))")
2466 : ! LCOV_EXCL_STOP
2467 : end if
2468 60003 : call test%assert(assertion, getOption(SK_"@test_getOrdinalDay(): The procedure must correctly compute the ordinal day for the specified or the current date.", msg), int(line, IK))
2469 20001 : end subroutine
2470 :
2471 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2472 :
2473 : end procedure
2474 :
2475 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2476 :
2477 1 : module procedure test_getWeekNumber
2478 :
2479 : use pm_distUnif, only: getUnifRand
2480 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2481 : integer(IKC) :: weekNumber, weekNumber_ref
2482 : integer(IKC), allocatable :: Values(:)
2483 : integer :: i
2484 1 : assertion = .true._LK
2485 :
2486 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2487 :
2488 1 : weekNumber_ref = +43_IKC
2489 5 : Values = [integer(IKC) :: +2022, +10, +26]
2490 1 : call runTests(__LINE__)
2491 :
2492 1 : weekNumber_ref = +18_IKC
2493 5 : Values = [integer(IKC) :: +2022, +5, +8]
2494 1 : call runTests(__LINE__)
2495 :
2496 1 : weekNumber_ref = +19_IKC
2497 5 : Values = [integer(IKC) :: +2022, +5, +9]
2498 1 : call runTests(__LINE__)
2499 :
2500 1 : weekNumber_ref = +19_IKC
2501 5 : Values = [integer(IKC) :: +2022, +5, +12]
2502 1 : call runTests(__LINE__)
2503 :
2504 1 : weekNumber_ref = +48_IKC
2505 5 : Values = [integer(IKC) :: -4713_IK, 11_IK, 24_IK]
2506 1 : call runTests(__LINE__)
2507 :
2508 1 : weekNumber_ref = +53_IKC
2509 5 : Values = [integer(IKC) :: -1_IK, 1_IK, 1_IK]
2510 1 : call runTests(__LINE__)
2511 :
2512 1 : weekNumber_ref = +52_IKC
2513 5 : Values = [integer(IKC) :: -1_IK, 12_IK, 31_IK]
2514 1 : call runTests(__LINE__)
2515 :
2516 1 : weekNumber_ref = +52_IKC
2517 5 : Values = [integer(IKC) :: 0_IK, 12_IK, 31_IK]
2518 1 : call runTests(__LINE__)
2519 :
2520 1 : weekNumber_ref = +1_IKC
2521 5 : Values = [integer(IKC) :: 1_IK, 12_IK, 31_IK]
2522 1 : call runTests(__LINE__)
2523 :
2524 1 : weekNumber_ref = +41_IKC
2525 5 : Values = [integer(IKC) :: 1582_IK, 10_IK, 15_IK]
2526 1 : call runTests(__LINE__)
2527 :
2528 1 : weekNumber_ref = +1_IKC
2529 5 : Values = [integer(IKC) :: 1901_IK, 1_IK, 1_IK]
2530 1 : call runTests(__LINE__)
2531 :
2532 1 : weekNumber_ref = +9_IKC
2533 5 : Values = [integer(IKC) :: 1999_IK, 3_IK, 1_IK]
2534 1 : call runTests(__LINE__)
2535 :
2536 1 : weekNumber_ref = +9_IKC
2537 5 : Values = [integer(IKC) :: 2000_IK, 3_IK, 1_IK]
2538 1 : call runTests(__LINE__)
2539 :
2540 1 : weekNumber_ref = +15_IKC
2541 5 : Values = [integer(IKC) :: 1999_IK, 4_IK, 15_IK]
2542 1 : call runTests(__LINE__)
2543 :
2544 1 : weekNumber_ref = +15_IKC
2545 5 : Values = [integer(IKC) :: 2000_IK, 4_IK, 15_IK]
2546 1 : call runTests(__LINE__)
2547 :
2548 1 : weekNumber_ref = +52_IKC
2549 5 : Values = [integer(IKC) :: 9999_IK, 12_IK, 31_IK]
2550 1 : call runTests(__LINE__)
2551 :
2552 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2553 :
2554 1 : do i = 1, 10
2555 1 : weekNumber = getWeekNumber()
2556 1 : weekNumber_ref = getWeekNumber(getDateTime())
2557 1 : if (weekNumber == weekNumber_ref) exit
2558 : end do
2559 1 : call report(__LINE__)
2560 :
2561 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2562 :
2563 : contains
2564 :
2565 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2566 :
2567 16 : subroutine runTests(line, msg)
2568 : integer, intent(in) :: line
2569 : character(*,SKC), intent(in), optional :: msg
2570 16 : weekNumber = getWeekNumber(Values)
2571 48 : call report(line, msg)
2572 16 : weekNumber = getWeekNumber(Values(1), Values(2), Values(3))
2573 16 : call report(line, msg)
2574 16 : end subroutine
2575 :
2576 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2577 :
2578 33 : subroutine report(line, msg)
2579 : use pm_option, only: getOption
2580 : integer, intent(in) :: line
2581 : character(*,SKC), intent(in), optional :: msg
2582 33 : assertion = assertion .and. logical(weekNumber == weekNumber_ref, LK)
2583 33 : if (test%traceable .and. .not. assertion) then
2584 : ! LCOV_EXCL_START
2585 : write(test%disp%unit,"(*(g0,:,', '))")
2586 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2587 : write(test%disp%unit,"(*(g0,:,', '))") "weekNumber ", weekNumber
2588 : write(test%disp%unit,"(*(g0,:,', '))") "weekNumber_ref ", weekNumber_ref
2589 : write(test%disp%unit,"(*(g0,:,', '))")
2590 : ! LCOV_EXCL_STOP
2591 : end if
2592 99 : call test%assert(assertion, getOption(SK_"@test_getWeekNumber(): The procedure must correctly compute the week number for the specified or the current date.", msg), int(line, IK))
2593 33 : end subroutine
2594 :
2595 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2596 :
2597 : end procedure
2598 :
2599 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2600 :
2601 1 : module procedure test_getWeekDay
2602 :
2603 : use pm_distUnif, only: getUnifRand
2604 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2605 : integer(IKC) :: weekDay, weekDay_ref
2606 : integer(IKC), allocatable :: Values(:)
2607 : integer :: i
2608 1 : assertion = .true._LK
2609 :
2610 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2611 :
2612 1 : weekDay_ref = +5_IKC
2613 5 : Values = [integer(IKC) :: 1582_IK, 10_IK, 15_IK]
2614 1 : call runTests(__LINE__)
2615 :
2616 1 : weekDay_ref = +1_IKC
2617 5 : Values = [integer(IKC) :: 1_IK, 1_IK, 1_IK]
2618 1 : call runTests(__LINE__)
2619 :
2620 1 : weekDay_ref = +6_IKC
2621 5 : Values = [integer(IKC) :: 2000_IK, 1_IK, 1_IK]
2622 1 : call runTests(__LINE__)
2623 :
2624 1 : weekDay_ref = +0_IKC
2625 5 : Values = [integer(IKC) :: 2022_IK, 11_IK, 6_IK]
2626 1 : call runTests(__LINE__)
2627 :
2628 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2629 :
2630 1 : do i = 1, 10
2631 1 : weekDay = getWeekDay()
2632 1 : weekDay_ref = getWeekDay(getDateTime())
2633 1 : if (weekDay == weekDay_ref) exit
2634 : end do
2635 1 : call report(__LINE__)
2636 :
2637 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2638 :
2639 : contains
2640 :
2641 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2642 :
2643 4 : subroutine runTests(line, msg)
2644 : integer, intent(in) :: line
2645 : character(*,SKC), intent(in), optional :: msg
2646 4 : weekDay = getWeekDay(Values)
2647 12 : call report(line, msg)
2648 4 : weekDay = getWeekDay(Values(1), Values(2), Values(3))
2649 4 : call report(line, msg)
2650 4 : end subroutine
2651 :
2652 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2653 :
2654 9 : subroutine report(line, msg)
2655 : use pm_option, only: getOption
2656 : integer, intent(in) :: line
2657 : character(*,SKC), intent(in), optional :: msg
2658 9 : assertion = assertion .and. logical(weekDay == weekDay_ref, LK)
2659 9 : if (test%traceable .and. .not. assertion) then
2660 : ! LCOV_EXCL_START
2661 : write(test%disp%unit,"(*(g0,:,', '))")
2662 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2663 : write(test%disp%unit,"(*(g0,:,', '))") "weekDay ", weekDay
2664 : write(test%disp%unit,"(*(g0,:,', '))") "weekDay_ref ", weekDay_ref
2665 : write(test%disp%unit,"(*(g0,:,', '))")
2666 : ! LCOV_EXCL_STOP
2667 : end if
2668 27 : call test%assert(assertion, getOption(SK_"@test_getWeekDay(): The procedure must correctly compute the week day for the specified or the current date.", msg), int(line, IK))
2669 9 : end subroutine
2670 :
2671 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2672 :
2673 : end procedure
2674 :
2675 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2676 :
2677 1 : module procedure test_getWeekDayISO
2678 :
2679 : use pm_distUnif, only: getUnifRand
2680 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2681 : integer(IKC) :: weekDay, weekDay_ref
2682 : integer(IKC), allocatable :: Values(:)
2683 : integer :: i
2684 1 : assertion = .true._LK
2685 :
2686 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2687 :
2688 1 : weekDay_ref = +5_IKC
2689 5 : Values = [integer(IKC) :: 1582_IK, 10_IK, 15_IK]
2690 1 : call runTests(__LINE__)
2691 :
2692 1 : weekDay_ref = +1_IKC
2693 5 : Values = [integer(IKC) :: 1_IK, 1_IK, 1_IK]
2694 1 : call runTests(__LINE__)
2695 :
2696 1 : weekDay_ref = +6_IKC
2697 5 : Values = [integer(IKC) :: 2000_IK, 1_IK, 1_IK]
2698 1 : call runTests(__LINE__)
2699 :
2700 1 : weekDay_ref = +7_IKC
2701 5 : Values = [integer(IKC) :: 2022_IK, 11_IK, 6_IK]
2702 1 : call runTests(__LINE__)
2703 :
2704 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2705 :
2706 1 : do i = 1, 10
2707 1 : weekDay = getWeekDayISO()
2708 1 : weekDay_ref = getWeekDayISO(getDateTime())
2709 1 : if (weekDay == weekDay_ref) exit
2710 : end do
2711 1 : call report(__LINE__)
2712 :
2713 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2714 :
2715 : contains
2716 :
2717 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2718 :
2719 4 : subroutine runTests(line, msg)
2720 : integer, intent(in) :: line
2721 : character(*,SKC), intent(in), optional :: msg
2722 4 : weekDay = getWeekDayISO(Values)
2723 12 : call report(line, msg)
2724 4 : weekDay = getWeekDayISO(Values(1), Values(2), Values(3))
2725 4 : call report(line, msg)
2726 4 : end subroutine
2727 :
2728 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2729 :
2730 9 : subroutine report(line, msg)
2731 : use pm_option, only: getOption
2732 : integer, intent(in) :: line
2733 : character(*,SKC), intent(in), optional :: msg
2734 9 : assertion = assertion .and. logical(weekDay == weekDay_ref, LK)
2735 9 : if (test%traceable .and. .not. assertion) then
2736 : ! LCOV_EXCL_START
2737 : write(test%disp%unit,"(*(g0,:,', '))")
2738 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2739 : write(test%disp%unit,"(*(g0,:,', '))") "weekDay ", weekDay
2740 : write(test%disp%unit,"(*(g0,:,', '))") "weekDay_ref ", weekDay_ref
2741 : write(test%disp%unit,"(*(g0,:,', '))")
2742 : ! LCOV_EXCL_STOP
2743 : end if
2744 27 : call test%assert(assertion, getOption(SK_"@test_getWeekDayISO(): The procedure must correctly compute the ISO week day for the specified or the current date.", msg), int(line, IK))
2745 9 : end subroutine
2746 :
2747 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2748 :
2749 : end procedure
2750 :
2751 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2752 :
2753 1 : module procedure test_getCountDays
2754 :
2755 : use pm_distUnif, only: getUnifRand
2756 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2757 : integer(IKC) :: countDays, countDays_ref
2758 : integer(IKC), allocatable :: Values(:)
2759 : integer :: i
2760 1 : assertion = .true._LK
2761 :
2762 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2763 :
2764 1001 : do i = 1, 1000
2765 :
2766 10000 : Values = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2767 1000 : countDays_ref = merge(366_IKC, 365_IKC, isLeapYear(Values(1)))
2768 1000 : countDays = getCountDays(Values(1))
2769 1000 : call report(__LINE__)
2770 :
2771 9000 : Values(1:8) = getDateTime(julianDay = getUnifRand(-300000._RKC, +300000._RKC))
2772 1000 : countDays_ref = merge(DAYS_OF_MONTH_LEAP(Values(2)), DAYS_OF_MONTH(Values(2)), isLeapYear(Values(1)))
2773 1000 : countDays = getCountDays(Values(1), Values(2))
2774 1001 : call report(__LINE__)
2775 :
2776 : end do
2777 :
2778 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2779 :
2780 : contains
2781 :
2782 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2783 :
2784 2000 : subroutine report(line, msg)
2785 : use pm_option, only: getOption
2786 : integer, intent(in) :: line
2787 : character(*,SKC), intent(in), optional :: msg
2788 2000 : assertion = assertion .and. logical(countDays == countDays_ref, LK)
2789 2000 : if (test%traceable .and. .not. assertion) then
2790 : ! LCOV_EXCL_START
2791 : write(test%disp%unit,"(*(g0,:,', '))")
2792 : write(test%disp%unit,"(*(g0,:,', '))") "Values ", Values
2793 : write(test%disp%unit,"(*(g0,:,', '))") "countDays ", countDays
2794 : write(test%disp%unit,"(*(g0,:,', '))") "countDays_ref ", countDays_ref
2795 : write(test%disp%unit,"(*(g0,:,', '))")
2796 : ! LCOV_EXCL_STOP
2797 : end if
2798 6000 : call test%assert(assertion, getOption(SK_"@test_getCountDays(): The procedure must correctly compute the day count for the specified or the current date.", msg), int(line, IK))
2799 2000 : end subroutine
2800 :
2801 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2802 :
2803 : end procedure
2804 :
2805 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2806 :
2807 1 : module procedure test_getCountWeeks
2808 :
2809 : use pm_arrayRange, only: getRange
2810 : use pm_distUnif, only: getUnifRand
2811 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2812 : integer(IKC), allocatable :: CountWeeks(:), CountWeeks_ref(:)
2813 : integer :: i
2814 1 : assertion = .true._LK
2815 :
2816 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2817 :
2818 23 : CountWeeks_ref = [integer(IKC) :: +52, +52, +52, +52, +53, +52, +52, +52, +52, +53, +52, +52, +52, +52, +52, +53, +52, +52, +52, +52, +53]
2819 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC))
2820 1 : call report(__LINE__)
2821 :
2822 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5]
2823 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 1_IKC)
2824 1 : call report(__LINE__)
2825 :
2826 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4, +4]
2827 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 2_IKC)
2828 1 : call report(__LINE__)
2829 :
2830 23 : CountWeeks_ref = [integer(IKC) :: +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4]
2831 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 3_IKC)
2832 1 : call report(__LINE__)
2833 :
2834 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +4, +4, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +4, +4, +4, +4, +5]
2835 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 4_IKC)
2836 1 : call report(__LINE__)
2837 :
2838 23 : CountWeeks_ref = [integer(IKC) :: +4, +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5, +4]
2839 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 5_IKC)
2840 1 : call report(__LINE__)
2841 :
2842 23 : CountWeeks_ref = [integer(IKC) :: +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4]
2843 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 6_IKC)
2844 1 : call report(__LINE__)
2845 :
2846 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5]
2847 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 7_IKC)
2848 1 : call report(__LINE__)
2849 :
2850 23 : CountWeeks_ref = [integer(IKC) :: +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4]
2851 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 8_IKC)
2852 1 : call report(__LINE__)
2853 :
2854 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +4, +4, +4, +4]
2855 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 9_IKC)
2856 1 : call report(__LINE__)
2857 :
2858 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +5, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5]
2859 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 10_IKC)
2860 1 : call report(__LINE__)
2861 :
2862 23 : CountWeeks_ref = [integer(IKC) :: +5, +5, +4, +4, +4, +4, +5, +5, +4, +4, +4, +4, +5, +4, +4, +4, +4, +5, +5, +4, +4]
2863 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 11_IKC)
2864 1 : call report(__LINE__)
2865 :
2866 23 : CountWeeks_ref = [integer(IKC) :: +4, +4, +4, +4, +5, +5, +4, +4, +4, +5, +5, +5, +4, +4, +4, +5, +5, +4, +4, +4, +5]
2867 44 : CountWeeks = getCountWeeks(getRange(2000_IKC, 2020_IKC), 12_IKC)
2868 1 : call report(__LINE__)
2869 :
2870 14 : CountWeeks_ref = [integer(IKC) :: +4, +4, +5, +4, +4, +5, +4, +4, +5, +4, +4, +5]
2871 26 : CountWeeks = getCountWeeks(2022_IKC, getRange(1_IKC, 12_IKC))
2872 1 : call report(__LINE__)
2873 :
2874 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2875 :
2876 : contains
2877 :
2878 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2879 :
2880 14 : subroutine report(line, msg)
2881 : use pm_option, only: getOption
2882 : integer, intent(in) :: line
2883 : character(*,SKC), intent(in), optional :: msg
2884 14 : assertion = assertion .and. logical(size(CountWeeks) == size(CountWeeks_ref), LK)
2885 42 : call test%assert(assertion, getOption(SK_"@test_getCountWeeks(): The sizes of `CountWeeks` and `CountWeeks_ref` must match.", msg), int(line, IK))
2886 299 : do i = 1, size(CountWeeks)
2887 285 : assertion = assertion .and. logical(CountWeeks(i) == CountWeeks_ref(i), LK)
2888 285 : if (test%traceable .and. .not. assertion) then
2889 : ! LCOV_EXCL_START
2890 : write(test%disp%unit,"(*(g0,:,', '))")
2891 : write(test%disp%unit,"(*(g0,:,', '))") "CountWeeks ", CountWeeks
2892 : write(test%disp%unit,"(*(g0,:,', '))") "CountWeeks_ref ", CountWeeks_ref
2893 : write(test%disp%unit,"(*(g0,:,', '))")
2894 : ! LCOV_EXCL_STOP
2895 : end if
2896 299 : call test%assert(assertion, getOption(SK_"@test_getCountWeeks(): The procedure must correctly compute the week counts for the specified or the current date.", msg), int(line, IK))
2897 : end do
2898 14 : end subroutine
2899 :
2900 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2901 :
2902 : end procedure
2903 :
2904 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2905 :
2906 1 : module procedure test_getCountLeapYears
2907 :
2908 : use pm_arrayRange, only: getRange
2909 : use pm_distUnif, only: getUnifRand
2910 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2911 : integer(IKC), allocatable :: CountLeapYears(:), CountLeapYears_ref(:)
2912 : integer :: i
2913 1 : assertion = .true._LK
2914 :
2915 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2916 :
2917 3 : CountLeapYears_ref = [integer(IKC) :: 0]
2918 4 : CountLeapYears = getCountLeapYears(until = [1_IKC])
2919 1 : call report(__LINE__)
2920 :
2921 3 : CountLeapYears_ref = [integer(IKC) :: +485]
2922 4 : CountLeapYears = getCountLeapYears(until = [2000_IKC])
2923 1 : call report(__LINE__)
2924 :
2925 3 : CountLeapYears_ref = [integer(IKC) :: +490]
2926 3 : CountLeapYears = [getCountLeapYears(until = 2022_IKC)]
2927 1 : call report(__LINE__)
2928 :
2929 3 : CountLeapYears_ref = [integer(IKC) :: +490]
2930 3 : CountLeapYears = [getCountLeapYears(until = 2022_IKC, since = 1_IKC)]
2931 1 : call report(__LINE__)
2932 :
2933 6 : CountLeapYears_ref = [integer(IKC) :: +0, +0, +0, +1]
2934 10 : CountLeapYears = getCountLeapYears(until = [1_IKC, 2_IKC, 3_IKC, 4_IKC])
2935 1 : call report(__LINE__)
2936 :
2937 13 : CountLeapYears_ref = [integer(IKC) :: +0, +1, +1, +1, +1, +2, +2, +2, +2, +3, +3]
2938 24 : CountLeapYears = getCountLeapYears(until = getRange(-5_IKC, 5_IKC, 1_IKC), since = -5_IKC)
2939 1 : call report(__LINE__)
2940 :
2941 19 : CountLeapYears_ref = [integer(IKC) :: -3, -2, -2, -2, -2, -1, -1, -1, -1, +0, +0, +0, +1, +1, +1, +1, +2]
2942 36 : CountLeapYears = getCountLeapYears(until = getRange(-8_IKC, 8_IKC, 1_IKC))
2943 1 : call report(__LINE__)
2944 :
2945 5 : CountLeapYears_ref = [integer(IKC) :: +6, +6, +5]
2946 8 : CountLeapYears = getCountLeapYears(until = 2022_IKC, since = [1999_IKC, 2000_IKC, 2001_IKC])
2947 1 : call report(__LINE__)
2948 :
2949 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2950 :
2951 : contains
2952 :
2953 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2954 :
2955 8 : subroutine report(line, msg)
2956 : use pm_option, only: getOption
2957 : integer, intent(in) :: line
2958 : character(*,SKC), intent(in), optional :: msg
2959 8 : assertion = assertion .and. logical(size(CountLeapYears) == size(CountLeapYears_ref), LK)
2960 8 : call test%assert(assertion, SK_"@test_getCountLeapYears(): The sizes of `CountLeapYears` and `CountLeapYears_ref` must match.", int(line, IK))
2961 47 : do i = 1, size(CountLeapYears)
2962 39 : assertion = assertion .and. logical(CountLeapYears(i) == CountLeapYears_ref(i), LK)
2963 39 : if (test%traceable .and. .not. assertion) then
2964 : ! LCOV_EXCL_START
2965 : write(test%disp%unit,"(*(g0,:,', '))")
2966 : write(test%disp%unit,"(*(g0,:,', '))") "CountLeapYears ", CountLeapYears
2967 : write(test%disp%unit,"(*(g0,:,', '))") "CountLeapYears_ref ", CountLeapYears_ref
2968 : write(test%disp%unit,"(*(g0,:,', '))")
2969 : ! LCOV_EXCL_STOP
2970 : end if
2971 125 : call test%assert(assertion, getOption(SK_"@test_getCountLeapYears(): The procedure must correctly compute the leap year counts for the specified or the current date.", msg), int(line, IK))
2972 : end do
2973 8 : end subroutine
2974 :
2975 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2976 :
2977 : end procedure
2978 :
2979 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2980 :
2981 1 : module procedure test_isValidZone
2982 :
2983 : use pm_arrayRange, only: getRange
2984 : use pm_distUnif, only: getUnifRand
2985 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
2986 : logical(LKC), allocatable :: IsValid(:), IsValid_ref(:)
2987 : integer(IKC), allocatable :: Zone(:)
2988 : integer :: i
2989 1 : assertion = .true._LK
2990 :
2991 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2992 :
2993 201 : do i = 1, 200
2994 2466 : Zone = getUnifRand(-1000_IKC, 1000_IKC, getUnifRand(1_IK, 20_IK))
2995 2466 : IsValid_ref = int(ZONE_MIN, IKC) <= Zone .and. Zone <= int(ZONE_MAX, IKC)
2996 200 : if (size(Zone) == 1 .and. getUnifRand()) then
2997 9 : IsValid = [isValidZone(Zone(1))]
2998 : else
2999 4520 : IsValid = isValidZone(Zone)
3000 : end if
3001 201 : call report(__LINE__)
3002 : end do
3003 :
3004 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3005 :
3006 : contains
3007 :
3008 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3009 :
3010 200 : subroutine report(line, msg)
3011 : use pm_val2str, only: getStr
3012 : use pm_option, only: getOption
3013 : integer, intent(in) :: line
3014 : character(*,SKC), intent(in), optional :: msg
3015 : integer :: i
3016 200 : assertion = assertion .and. logical(size(IsValid) == size(IsValid_ref), LK)
3017 600 : call test%assert(assertion, SK_"@test_getCountLeapYears(): The sizes of `IsValid` and `IsValid_ref` must match. size(IsValid), size(IsValid) = "//getStr([size(IsValid), size(IsValid)]), int(line, IK))
3018 2266 : do i = 1, size(IsValid)
3019 2066 : assertion = assertion .and. logical(IsValid(i) .eqv. IsValid_ref(i), LK)
3020 2066 : if (test%traceable .and. .not. assertion) then
3021 : ! LCOV_EXCL_START
3022 : write(test%disp%unit,"(*(g0,:,', '))")
3023 : write(test%disp%unit,"(*(g0,:,', '))") "Zone ", Zone
3024 : write(test%disp%unit,"(*(g0,:,', '))") "IsValid ", IsValid
3025 : write(test%disp%unit,"(*(g0,:,', '))") "IsValid_ref ", IsValid_ref
3026 : write(test%disp%unit,"(*(g0,:,', '))")
3027 : ! LCOV_EXCL_STOP
3028 : end if
3029 6398 : call test%assert(assertion, getOption(SK_"@test_isValidZone(): The procedure must correctly recognize a valid zone.", msg), int(line, IK))
3030 : end do
3031 200 : end subroutine
3032 :
3033 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3034 :
3035 : end procedure
3036 :
3037 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3038 :
3039 1 : module procedure test_isMorning
3040 :
3041 : use pm_arrayRange, only: getRange
3042 : use pm_distUnif, only: getUnifRand
3043 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
3044 : logical(LKC), allocatable :: Morning(:), Morning_ref(:)
3045 : integer(IKC), allocatable :: Zone(:)
3046 : real(RKC), allocatable :: JulianDay(:), JulianDayUTC(:)
3047 : integer :: i, j
3048 1 : assertion = .true._LK
3049 :
3050 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3051 :
3052 501 : do i = 1, 500
3053 :
3054 500 : do j = 1, 10
3055 977 : Zone = getUnifRand(int(ZONE_MIN, IKC), int(ZONE_MAX, IKC), getUnifRand(1_IK, 10_IK))
3056 500 : if (size(Zone) == 1 .and. getUnifRand()) then
3057 45 : Morning = [isMorning(Zone(1))]
3058 : else
3059 6512 : Morning = [isMorning(Zone)]
3060 : end if
3061 6572 : Morning_ref = [getHour(Zone) < 12_IKC]
3062 3286 : if (all(Morning .eqv. Morning_ref)) exit
3063 : end do
3064 500 : call report(__LINE__, Zone = Zone)
3065 :
3066 969 : JulianDay = getUnifRand(-300000._RKC, +300000._RKC, getUnifRand(1_IK, 20_IK))
3067 6307 : Morning_ref = logical(JulianDay - real(floor(JulianDay, IK), RKC) >= 0.5_RKC, LK)
3068 500 : if (size(JulianDay) == 1 .and. getUnifRand()) then
3069 39 : Morning = [isMorning(JulianDay(1))]
3070 : else
3071 11562 : Morning = isMorning(JulianDay)
3072 : end if
3073 500 : call report(__LINE__, JulianDay = JulianDay)
3074 :
3075 976 : Zone = getUnifRand(int(ZONE_MIN, IKC), int(ZONE_MAX, IKC), size(JulianDay, kind = IK))
3076 500 : if (size(JulianDay) == 1 .and. getUnifRand()) then
3077 36 : Morning = [isMorning(JulianDay(1), Zone(1))]
3078 : else
3079 11566 : Morning = isMorning(JulianDay, Zone)
3080 : end if
3081 6307 : JulianDayUTC = JulianDay + Zone / real(MINUTES_PER_DAY, RKC)
3082 6307 : Morning_ref = logical(JulianDayUTC - real(floor(JulianDayUTC, IK), RKC) >= 0.5_RKC, LK)
3083 501 : call report(__LINE__, JulianDay = JulianDay, Zone = Zone)
3084 :
3085 : end do
3086 :
3087 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3088 :
3089 1 : do i = 1, 10
3090 3 : Morning = [isMorning()]
3091 3 : Morning_ref = [getHour() < 12_IKC]
3092 2 : if (all(Morning .eqv. Morning_ref)) exit
3093 : end do
3094 1 : call report(__LINE__)
3095 :
3096 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3097 :
3098 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3099 :
3100 : contains
3101 :
3102 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3103 :
3104 1501 : subroutine report(line, msg, JulianDay, Zone)
3105 : use pm_val2str, only: getStr
3106 : use pm_option, only: getOption
3107 : integer, intent(in) :: line
3108 : character(*,SKC), intent(in), optional :: msg
3109 : integer(IKC), intent(in), contiguous, optional :: Zone(:)
3110 : real(RKC), intent(in), contiguous, optional :: JulianDay(:)
3111 : integer :: i
3112 1501 : assertion = assertion .and. logical(size(Morning) == size(Morning_ref), LK)
3113 4503 : call test%assert(assertion, SK_"@test_getCountLeapYears(): The sizes of `Morning` and `Morning_ref` must match. size(Morning), size(Morning) = "//getStr([size(Morning), size(Morning)]), int(line, IK))
3114 14902 : do i = 1, size(Morning)
3115 13401 : assertion = assertion .and. logical(Morning(i) .eqv. Morning_ref(i), LK)
3116 13401 : if (test%traceable .and. .not. assertion) then
3117 : ! LCOV_EXCL_START
3118 : write(test%disp%unit,"(*(g0,:,', '))")
3119 : if (present(JulianDay)) then
3120 : write(test%disp%unit,"(*(g0,:,', '))") "JulianDay ", JulianDay
3121 : end if
3122 : if (present(Zone)) then
3123 : write(test%disp%unit,"(*(g0,:,', '))") "Zone ", Zone
3124 : end if
3125 : write(test%disp%unit,"(*(g0,:,', '))") "Morning ", Morning
3126 : write(test%disp%unit,"(*(g0,:,', '))") "Morning_ref ", Morning_ref
3127 : write(test%disp%unit,"(*(g0,:,', '))")
3128 : ! LCOV_EXCL_STOP
3129 : end if
3130 41704 : call test%assert(assertion, getOption(SK_"@test_isMorning(): The procedure must correctly recognize morning hours.", msg), int(line, IK))
3131 : end do
3132 1501 : end subroutine
3133 :
3134 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3135 :
3136 : end procedure
3137 :
3138 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3139 :
3140 1 : module procedure test_getZone
3141 : use pm_arrayRange, only: getRange
3142 : use pm_distUnif, only: getUnifRand
3143 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
3144 : integer(IKC) :: zone, zone_ref, Values(8)
3145 : integer :: i
3146 1 : assertion = .true._LK
3147 501 : do i = 1, 500
3148 500 : zone = getZone()
3149 500 : call date_and_time(Values = Values)
3150 500 : zone_ref = ValueS(4)
3151 501 : call report(__LINE__)
3152 : end do
3153 : contains
3154 500 : subroutine report(line)
3155 : use pm_val2str, only: getStr
3156 : integer, intent(in) :: line
3157 500 : assertion = assertion .and. logical(zone == zone_ref, LK)
3158 500 : if (test%traceable .and. .not. assertion) then
3159 : ! LCOV_EXCL_START
3160 : write(test%disp%unit,"(*(g0,:,', '))")
3161 : write(test%disp%unit,"(*(g0,:,', '))") "zone ", zone
3162 : write(test%disp%unit,"(*(g0,:,', '))") "zone_ref", zone_ref
3163 : write(test%disp%unit,"(*(g0,:,', '))")
3164 : ! LCOV_EXCL_STOP
3165 : end if
3166 500 : call test%assert(assertion, SK_"@test_getZone(): The local zone must be inferred correctly.", int(line, IK))
3167 500 : end subroutine
3168 : end procedure
3169 :
3170 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3171 :
3172 1 : module procedure test_getMillisecond
3173 : use pm_arrayRange, only: getRange
3174 : use pm_distUnif, only: getUnifRand
3175 : use pm_kind, only: SKC => SK, IKC => IK, RKC => RK, LKC => LK
3176 : integer(IKC) :: millisecond
3177 : integer :: i
3178 1 : assertion = .true._LK
3179 501 : do i = 1, 500
3180 500 : millisecond = getMillisecond()
3181 501 : call report(__LINE__)
3182 : end do
3183 : contains
3184 500 : subroutine report(line)
3185 : use pm_val2str, only: getStr
3186 : integer, intent(in) :: line
3187 500 : assertion = assertion .and. logical(0_IKC <= millisecond .and. millisecond < 1000_IKC, LK)
3188 500 : if (test%traceable .and. .not. assertion) then
3189 : ! LCOV_EXCL_START
3190 : write(test%disp%unit,"(*(g0,:,', '))")
3191 : write(test%disp%unit,"(*(g0,:,', '))") "millisecond", millisecond
3192 : write(test%disp%unit,"(*(g0,:,', '))")
3193 : ! LCOV_EXCL_STOP
3194 : end if
3195 500 : call test%assert(assertion, SK_"@test_getMillisecond(): The local millisecond must be inferred correctly within the limits.", int(line, IK))
3196 500 : end subroutine
3197 : end procedure
3198 :
3199 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3200 :
3201 : #if 0
3202 : #define getMahalSq_ENABLED 1
3203 :
3204 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3205 :
3206 : #define CK_ENABLED 1
3207 :
3208 : #if CK5_ENABLED
3209 : module procedure test_getMahalSq_CK5
3210 : use pm_kind, only: IK, CK => CK5
3211 : #include "test_pm_dateTime@routines.inc.F90"
3212 : end procedure
3213 : #endif
3214 :
3215 : #if CK4_ENABLED
3216 : module procedure test_getMahalSq_CK4
3217 : use pm_kind, only: IK, CK => CK4
3218 : #include "test_pm_dateTime@routines.inc.F90"
3219 : end procedure
3220 : #endif
3221 :
3222 : #if CK3_ENABLED
3223 : module procedure test_getMahalSq_CK3
3224 : use pm_kind, only: IK, CK => CK3
3225 : #include "test_pm_dateTime@routines.inc.F90"
3226 : end procedure
3227 : #endif
3228 :
3229 : #if CK2_ENABLED
3230 : module procedure test_getMahalSq_CK2
3231 : use pm_kind, only: IK, CK => CK2
3232 : #include "test_pm_dateTime@routines.inc.F90"
3233 : end procedure
3234 : #endif
3235 :
3236 : #if CK1_ENABLED
3237 : module procedure test_getMahalSq_CK1
3238 : use pm_kind, only: IK, CK => CK1
3239 : #include "test_pm_dateTime@routines.inc.F90"
3240 : end procedure
3241 : #endif
3242 :
3243 : #undef CK_ENABLED
3244 :
3245 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3246 :
3247 : #undef getMahalSq_ENABLED
3248 : #endif
3249 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3250 :
3251 : end submodule routines ! LCOV_EXCL_LINE
|
