1 | !$$$ need to test with ESMF_ instead of WRFU_ ... |
---|
2 | ! |
---|
3 | ! Sub-system tests for esmf_time_f90 |
---|
4 | ! |
---|
5 | ! Someday, switch over to funit! |
---|
6 | ! |
---|
7 | |
---|
8 | MODULE my_tests |
---|
9 | USE module_utility |
---|
10 | IMPLICIT NONE |
---|
11 | |
---|
12 | ! Set this to .TRUE. to make wrf_error_fatal() print a message on failure |
---|
13 | ! instead of stopping the program. Use for testing only (since we cannot |
---|
14 | ! catch exceptions in Fortran90!!) |
---|
15 | LOGICAL :: WRF_ERROR_FATAL_PRINT = .TRUE. !FALSE. |
---|
16 | |
---|
17 | CONTAINS |
---|
18 | |
---|
19 | ! Test printing of an ESMF_Time or ESMF_TimeInterval object. |
---|
20 | ! |
---|
21 | ! Correct results are also passed in through this interface and compared |
---|
22 | ! with computed results. PASS/FAIL messages are printed. |
---|
23 | ! |
---|
24 | SUBROUTINE test_print( t_yy, t_mm, t_dd, t_h, t_m, t_s, t_sn, t_sd, & |
---|
25 | ti_yy, ti_mm, ti_dd, ti_h, ti_m, ti_s, ti_sn, ti_sd, & |
---|
26 | res_str, testname, expect_error ) |
---|
27 | INTEGER, INTENT(IN), OPTIONAL :: t_YY |
---|
28 | INTEGER, INTENT(IN), OPTIONAL :: t_MM ! month |
---|
29 | INTEGER, INTENT(IN), OPTIONAL :: t_DD ! day of month |
---|
30 | INTEGER, INTENT(IN), OPTIONAL :: t_H |
---|
31 | INTEGER, INTENT(IN), OPTIONAL :: t_M |
---|
32 | INTEGER, INTENT(IN), OPTIONAL :: t_S |
---|
33 | INTEGER, INTENT(IN), OPTIONAL :: t_Sn |
---|
34 | INTEGER, INTENT(IN), OPTIONAL :: t_Sd |
---|
35 | INTEGER, INTENT(IN), OPTIONAL :: ti_YY |
---|
36 | INTEGER, INTENT(IN), OPTIONAL :: ti_MM ! month |
---|
37 | INTEGER, INTENT(IN), OPTIONAL :: ti_DD ! day of month |
---|
38 | INTEGER, INTENT(IN), OPTIONAL :: ti_H |
---|
39 | INTEGER, INTENT(IN), OPTIONAL :: ti_M |
---|
40 | INTEGER, INTENT(IN), OPTIONAL :: ti_S |
---|
41 | INTEGER, INTENT(IN), OPTIONAL :: ti_Sn |
---|
42 | INTEGER, INTENT(IN), OPTIONAL :: ti_Sd |
---|
43 | CHARACTER (LEN=*), INTENT(IN) :: res_str |
---|
44 | CHARACTER (LEN=*), INTENT(IN), OPTIONAL :: testname |
---|
45 | LOGICAL, OPTIONAL, INTENT(IN) :: expect_error |
---|
46 | ! locals |
---|
47 | INTEGER :: it_YY |
---|
48 | INTEGER :: it_MM ! month |
---|
49 | INTEGER :: it_DD ! day of month |
---|
50 | INTEGER :: it_H |
---|
51 | INTEGER :: it_M |
---|
52 | INTEGER :: it_S |
---|
53 | INTEGER :: it_Sn |
---|
54 | INTEGER :: it_Sd |
---|
55 | INTEGER :: iti_YY |
---|
56 | INTEGER :: iti_MM ! month |
---|
57 | INTEGER :: iti_DD ! day of month |
---|
58 | INTEGER :: iti_H |
---|
59 | INTEGER :: iti_M |
---|
60 | INTEGER :: iti_S |
---|
61 | INTEGER :: iti_Sn |
---|
62 | INTEGER :: iti_Sd |
---|
63 | LOGICAL :: is_t |
---|
64 | LOGICAL :: is_ti |
---|
65 | CHARACTER (LEN=512) :: itestname |
---|
66 | LOGICAL :: iexpect_error |
---|
67 | INTEGER rc |
---|
68 | TYPE(WRFU_Time) :: t |
---|
69 | TYPE(WRFU_TimeInterval) :: ti |
---|
70 | CHARACTER(LEN=WRFU_MAXSTR) :: str, computed_str, frac_str |
---|
71 | CHARACTER(LEN=17) :: type_str |
---|
72 | INTEGER :: res_len, computed_len |
---|
73 | LOGICAL :: test_passed |
---|
74 | |
---|
75 | ! PRINT *,'DEBUG: BEGIN test_print()' |
---|
76 | it_YY = 0 |
---|
77 | it_MM = 1 ! same as Earth more simple |
---|
78 | it_DD = 1 ! same as Earth more simple |
---|
79 | it_H = 0 |
---|
80 | it_M = 0 |
---|
81 | it_S = 0 |
---|
82 | it_Sn = 0 |
---|
83 | it_Sd = 0 |
---|
84 | iti_YY = 0 |
---|
85 | iti_MM = 0 |
---|
86 | iti_DD = 0 |
---|
87 | iti_H = 0 |
---|
88 | iti_M = 0 |
---|
89 | iti_S = 0 |
---|
90 | iti_Sn = 0 |
---|
91 | iti_Sd = 0 |
---|
92 | itestname = '' |
---|
93 | iexpect_error = .FALSE. |
---|
94 | |
---|
95 | IF ( PRESENT( t_YY ) ) it_YY = t_YY |
---|
96 | IF ( PRESENT( t_MM ) ) it_MM = t_MM |
---|
97 | IF ( PRESENT( t_DD ) ) it_DD = t_DD |
---|
98 | IF ( PRESENT( t_H ) ) it_H = t_H |
---|
99 | IF ( PRESENT( t_M ) ) it_M = t_M |
---|
100 | IF ( PRESENT( t_S ) ) it_S = t_S |
---|
101 | IF ( PRESENT( t_Sn ) ) it_Sn = t_Sn |
---|
102 | IF ( PRESENT( t_Sd ) ) it_Sd = t_Sd |
---|
103 | IF ( PRESENT( ti_YY ) ) iti_YY = ti_YY |
---|
104 | IF ( PRESENT( ti_MM ) ) iti_MM = ti_MM |
---|
105 | IF ( PRESENT( ti_DD ) ) iti_DD = ti_DD |
---|
106 | IF ( PRESENT( ti_H ) ) iti_H = ti_H |
---|
107 | IF ( PRESENT( ti_M ) ) iti_M = ti_M |
---|
108 | IF ( PRESENT( ti_S ) ) iti_S = ti_S |
---|
109 | IF ( PRESENT( ti_Sn ) ) iti_Sn = ti_Sn |
---|
110 | IF ( PRESENT( ti_Sd ) ) iti_Sd = ti_Sd |
---|
111 | IF ( PRESENT( testname ) ) itestname = TRIM(testname) |
---|
112 | IF ( PRESENT( expect_error ) ) iexpect_error = expect_error |
---|
113 | |
---|
114 | ! Ensure that optional arguments are consistent... |
---|
115 | is_t = ( PRESENT( t_YY ) .OR. PRESENT( t_MM ) .OR. & |
---|
116 | PRESENT( t_DD ) .OR. PRESENT( t_H ) .OR. & |
---|
117 | PRESENT( t_M ) .OR. PRESENT( t_S ) .OR. & |
---|
118 | PRESENT( t_Sn ) .OR. PRESENT( t_Sd ) ) |
---|
119 | is_ti = ( PRESENT( ti_YY ) .OR. PRESENT( ti_MM ) .OR. & |
---|
120 | PRESENT( ti_DD ) .OR. PRESENT( ti_H ) .OR. & |
---|
121 | PRESENT( ti_M ) .OR. PRESENT( ti_S ) .OR. & |
---|
122 | PRESENT( ti_Sn ) .OR. PRESENT( ti_Sd ) ) |
---|
123 | IF ( is_t .EQV. is_ti ) THEN |
---|
124 | CALL wrf_error_fatal( & |
---|
125 | 'ERROR test_print: inconsistent args' ) |
---|
126 | ENDIF |
---|
127 | |
---|
128 | !PRINT *,'DEBUG: test_print(): init objects' |
---|
129 | ! Initialize object to be tested |
---|
130 | ! modify behavior of wrf_error_fatal for tests |
---|
131 | IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .TRUE. |
---|
132 | IF ( is_t ) THEN |
---|
133 | type_str = 'ESMF_Time' |
---|
134 | !PRINT *,'DEBUG: test_print(): calling WRFU_TimeSet()' |
---|
135 | !PRINT *,'DEBUG: test_print(): YY,MM,DD,H,M,S,Sn,Sd = ', it_YY,it_MM,it_DD,it_H,it_M,it_S,it_Sn,it_Sd |
---|
136 | CALL WRFU_TimeSet( t, YY=it_YY, MM=it_MM, DD=it_DD , & |
---|
137 | H=it_H, M=it_M, S=it_S, Sn=it_Sn, Sd=it_Sd, rc=rc ) |
---|
138 | !PRINT *,'DEBUG: test_print(): back from WRFU_TimeSet()' |
---|
139 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
140 | TRIM(itestname)//'WRFU_TimeSet() ', & |
---|
141 | __FILE__ , & |
---|
142 | __LINE__ ) |
---|
143 | !PRINT *,'DEBUG: test_print(): calling WRFU_TimeGet()' |
---|
144 | CALL WRFU_TimeGet( t, timeString=computed_str, rc=rc ) |
---|
145 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
146 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
147 | __FILE__ , & |
---|
148 | __LINE__ ) |
---|
149 | !PRINT *,'DEBUG: test_print(): back from WRFU_TimeGet(), computed_str = ',TRIM(computed_str) |
---|
150 | ! handle fractions |
---|
151 | IF ( t%basetime%Sd > 0 ) THEN |
---|
152 | IF ( t%basetime%Sn > 0 ) THEN |
---|
153 | WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(t%basetime%Sn), t%basetime%Sd |
---|
154 | ELSE IF ( t%basetime%Sn < 0 ) THEN |
---|
155 | WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(t%basetime%Sn), t%basetime%Sd |
---|
156 | ELSE |
---|
157 | frac_str = '' |
---|
158 | ENDIF |
---|
159 | computed_str = TRIM(computed_str)//TRIM(frac_str) |
---|
160 | ENDIF |
---|
161 | !PRINT *,'DEBUG: test_print(): back from WRFU_TimeGet(), computed_str = ',TRIM(computed_str) |
---|
162 | ELSE |
---|
163 | type_str = 'ESMF_TimeInterval' |
---|
164 | !PRINT *,'DEBUG: test_print(): calling WRFU_TimeIntervalSet()' |
---|
165 | CALL WRFU_TimeIntervalSet( ti, YY=iti_YY, MM=iti_MM, & |
---|
166 | D=iti_DD , & |
---|
167 | H=iti_H, M=iti_M, & |
---|
168 | S=iti_S, Sn=iti_Sn, Sd=iti_Sd, rc=rc ) |
---|
169 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
170 | TRIM(itestname)//'WRFU_TimeIntervalSet() ', & |
---|
171 | __FILE__ , & |
---|
172 | __LINE__ ) |
---|
173 | !PRINT *,'DEBUG: test_print(): calling WRFU_TimeIntervalGet()' |
---|
174 | CALL WRFU_TimeIntervalGet( ti, timeString=computed_str, rc=rc ) |
---|
175 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
176 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
177 | __FILE__ , & |
---|
178 | __LINE__ ) |
---|
179 | ! handle fractions |
---|
180 | IF ( ti%basetime%Sd > 0 ) THEN |
---|
181 | IF ( ti%basetime%Sn > 0 ) THEN |
---|
182 | WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(ti%basetime%Sn), ti%basetime%Sd |
---|
183 | ELSE IF ( ti%basetime%Sn < 0 ) THEN |
---|
184 | WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(ti%basetime%Sn), ti%basetime%Sd |
---|
185 | ELSE |
---|
186 | frac_str = '' |
---|
187 | ENDIF |
---|
188 | computed_str = TRIM(computed_str)//TRIM(frac_str) |
---|
189 | ENDIF |
---|
190 | ENDIF |
---|
191 | ! restore default behavior of wrf_error_fatal |
---|
192 | IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .FALSE. |
---|
193 | !PRINT *,'DEBUG: test_print(): done init objects' |
---|
194 | |
---|
195 | !PRINT *,'DEBUG: test_print(): check result' |
---|
196 | ! check result |
---|
197 | test_passed = .FALSE. |
---|
198 | res_len = LEN_TRIM(res_str) |
---|
199 | computed_len = LEN_TRIM(computed_str) |
---|
200 | IF ( res_len == computed_len ) THEN |
---|
201 | IF ( computed_str(1:computed_len) == res_str(1:res_len) ) THEN |
---|
202 | test_passed = .TRUE. |
---|
203 | ENDIF |
---|
204 | ENDIF |
---|
205 | IF ( test_passed ) THEN |
---|
206 | WRITE(*,FMT='(A)') 'PASS: '//TRIM(itestname) |
---|
207 | ELSE |
---|
208 | WRITE(*,'(9A)') 'FAIL: ',TRIM(itestname),': printing ',TRIM(type_str), & |
---|
209 | ' expected <', TRIM(res_str),'> but computed <',TRIM(computed_str),'>' |
---|
210 | ENDIF |
---|
211 | !PRINT *,'DEBUG: END test_print()' |
---|
212 | |
---|
213 | END SUBROUTINE test_print |
---|
214 | |
---|
215 | |
---|
216 | |
---|
217 | ! Test the following arithmetic operations on ESMF_Time and |
---|
218 | ! ESMF_TimeInterval objects: |
---|
219 | ! ESMF_Time = ESMF_Time + ESMF_TimeInterval |
---|
220 | ! ESMF_Time = ESMF_TimeInterval + ESMF_Time |
---|
221 | ! ESMF_Time = ESMF_Time - ESMF_TimeInterval |
---|
222 | ! ESMF_TimeInterval = ESMF_Time - ESMF_Time |
---|
223 | ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval |
---|
224 | ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval |
---|
225 | ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER |
---|
226 | ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER |
---|
227 | ! |
---|
228 | ! Correct results are also passed in through this interface and compared |
---|
229 | ! with computed results. PASS/FAIL messages are printed. |
---|
230 | ! |
---|
231 | ! Operations are expressed as res = op1 +|- op2 |
---|
232 | ! |
---|
233 | SUBROUTINE test_arithmetic( add_op, multiply_op, & |
---|
234 | op1_t_yy, op1_t_mm, op1_t_dd, op1_t_h, op1_t_m, op1_t_s, op1_t_sn, op1_t_sd, & |
---|
235 | op1_ti_yy, op1_ti_mm, op1_ti_dd, op1_ti_h, op1_ti_m, op1_ti_s, op1_ti_sn, op1_ti_sd, & |
---|
236 | op2_t_yy, op2_t_mm, op2_t_dd, op2_t_h, op2_t_m, op2_t_s, op2_t_sn, op2_t_sd, & |
---|
237 | op2_ti_yy, op2_ti_mm, op2_ti_dd, op2_ti_h, op2_ti_m, op2_ti_s, op2_ti_sn, op2_ti_sd, & |
---|
238 | op2_int, & |
---|
239 | res_t_yy, res_t_mm, res_t_dd, res_t_h, res_t_m, res_t_s, res_t_sn, res_t_sd, & |
---|
240 | res_ti_yy, res_ti_mm, res_ti_dd, res_ti_h, res_ti_m, res_ti_s, res_ti_sn, res_ti_sd, & |
---|
241 | testname, expect_error ) |
---|
242 | LOGICAL, INTENT(IN), OPTIONAL :: add_op ! .TRUE.=add, .FALSE.=subtract |
---|
243 | LOGICAL, INTENT(IN), OPTIONAL :: multiply_op ! .TRUE.=multiply, .FALSE.=divide |
---|
244 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_YY |
---|
245 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_MM ! month |
---|
246 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_DD ! day of month |
---|
247 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_H |
---|
248 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_M |
---|
249 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_S |
---|
250 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_Sn |
---|
251 | INTEGER, INTENT(IN), OPTIONAL :: op1_t_Sd |
---|
252 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_YY |
---|
253 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_MM ! month |
---|
254 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_DD ! day of month |
---|
255 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_H |
---|
256 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_M |
---|
257 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_S |
---|
258 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_Sn |
---|
259 | INTEGER, INTENT(IN), OPTIONAL :: op1_ti_Sd |
---|
260 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_YY |
---|
261 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_MM ! month |
---|
262 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_DD ! day of month |
---|
263 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_H |
---|
264 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_M |
---|
265 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_S |
---|
266 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_Sn |
---|
267 | INTEGER, INTENT(IN), OPTIONAL :: op2_t_Sd |
---|
268 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_YY |
---|
269 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_MM ! month |
---|
270 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_DD ! day of month |
---|
271 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_H |
---|
272 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_M |
---|
273 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_S |
---|
274 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_Sn |
---|
275 | INTEGER, INTENT(IN), OPTIONAL :: op2_ti_Sd |
---|
276 | INTEGER, INTENT(IN), OPTIONAL :: op2_int |
---|
277 | INTEGER, INTENT(IN), OPTIONAL :: res_t_YY |
---|
278 | INTEGER, INTENT(IN), OPTIONAL :: res_t_MM ! month |
---|
279 | INTEGER, INTENT(IN), OPTIONAL :: res_t_DD ! day of month |
---|
280 | INTEGER, INTENT(IN), OPTIONAL :: res_t_H |
---|
281 | INTEGER, INTENT(IN), OPTIONAL :: res_t_M |
---|
282 | INTEGER, INTENT(IN), OPTIONAL :: res_t_S |
---|
283 | INTEGER, INTENT(IN), OPTIONAL :: res_t_Sn |
---|
284 | INTEGER, INTENT(IN), OPTIONAL :: res_t_Sd |
---|
285 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_YY |
---|
286 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_MM ! month |
---|
287 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_DD ! day of month |
---|
288 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_H |
---|
289 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_M |
---|
290 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_S |
---|
291 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_Sn |
---|
292 | INTEGER, INTENT(IN), OPTIONAL :: res_ti_Sd |
---|
293 | CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: testname |
---|
294 | LOGICAL, OPTIONAL, INTENT(IN) :: expect_error |
---|
295 | ! locals |
---|
296 | LOGICAL :: iadd_op |
---|
297 | LOGICAL :: isubtract_op |
---|
298 | LOGICAL :: imultiply_op |
---|
299 | LOGICAL :: idivide_op |
---|
300 | INTEGER :: iop1_t_YY |
---|
301 | INTEGER :: iop1_t_MM ! month |
---|
302 | INTEGER :: iop1_t_DD ! day of month |
---|
303 | INTEGER :: iop1_t_H |
---|
304 | INTEGER :: iop1_t_M |
---|
305 | INTEGER :: iop1_t_S |
---|
306 | INTEGER :: iop1_t_Sn |
---|
307 | INTEGER :: iop1_t_Sd |
---|
308 | INTEGER :: iop1_ti_YY |
---|
309 | INTEGER :: iop1_ti_MM ! month |
---|
310 | INTEGER :: iop1_ti_DD ! day of month |
---|
311 | INTEGER :: iop1_ti_H |
---|
312 | INTEGER :: iop1_ti_M |
---|
313 | INTEGER :: iop1_ti_S |
---|
314 | INTEGER :: iop1_ti_Sn |
---|
315 | INTEGER :: iop1_ti_Sd |
---|
316 | INTEGER :: iop2_t_YY |
---|
317 | INTEGER :: iop2_t_MM ! month |
---|
318 | INTEGER :: iop2_t_DD ! day of month |
---|
319 | INTEGER :: iop2_t_H |
---|
320 | INTEGER :: iop2_t_M |
---|
321 | INTEGER :: iop2_t_S |
---|
322 | INTEGER :: iop2_t_Sn |
---|
323 | INTEGER :: iop2_t_Sd |
---|
324 | INTEGER :: iop2_ti_YY |
---|
325 | INTEGER :: iop2_ti_MM ! month |
---|
326 | INTEGER :: iop2_ti_DD ! day of month |
---|
327 | INTEGER :: iop2_ti_H |
---|
328 | INTEGER :: iop2_ti_M |
---|
329 | INTEGER :: iop2_ti_S |
---|
330 | INTEGER :: iop2_ti_Sn |
---|
331 | INTEGER :: iop2_ti_Sd |
---|
332 | INTEGER :: ires_t_YY |
---|
333 | INTEGER :: ires_t_MM ! month |
---|
334 | INTEGER :: ires_t_DD ! day of month |
---|
335 | INTEGER :: ires_t_H |
---|
336 | INTEGER :: ires_t_M |
---|
337 | INTEGER :: ires_t_S |
---|
338 | INTEGER :: ires_t_Sn |
---|
339 | INTEGER :: ires_t_Sd |
---|
340 | INTEGER :: ires_ti_YY |
---|
341 | INTEGER :: ires_ti_MM ! month |
---|
342 | INTEGER :: ires_ti_DD ! day of month |
---|
343 | INTEGER :: ires_ti_H |
---|
344 | INTEGER :: ires_ti_M |
---|
345 | INTEGER :: ires_ti_S |
---|
346 | INTEGER :: ires_ti_Sn |
---|
347 | INTEGER :: ires_ti_Sd |
---|
348 | LOGICAL :: op1_is_t , op2_is_t , res_is_t |
---|
349 | LOGICAL :: op1_is_ti, op2_is_ti, res_is_ti, op2_is_int |
---|
350 | INTEGER :: num_ops, num_op2 |
---|
351 | LOGICAL :: unsupported_op, test_passed |
---|
352 | CHARACTER (LEN=512) :: itestname |
---|
353 | LOGICAL :: iexpect_error |
---|
354 | INTEGER rc |
---|
355 | TYPE(WRFU_Time) :: op1_t , op2_t , res_t, computed_t |
---|
356 | TYPE(WRFU_TimeInterval) :: op1_ti, op2_ti, res_ti, computed_ti |
---|
357 | CHARACTER(LEN=WRFU_MAXSTR) :: str, op1_str, op2_str, res_str, computed_str, frac_str |
---|
358 | CHARACTER(LEN=1) :: op_str |
---|
359 | CHARACTER(LEN=17) :: op1_type_str, op2_type_str, res_type_str |
---|
360 | |
---|
361 | iadd_op = .FALSE. |
---|
362 | isubtract_op = .FALSE. |
---|
363 | imultiply_op = .FALSE. |
---|
364 | idivide_op = .FALSE. |
---|
365 | iop1_t_YY = 0 |
---|
366 | iop1_t_MM = 1 !see above |
---|
367 | iop1_t_DD = 1 !see above |
---|
368 | iop1_t_H = 0 |
---|
369 | iop1_t_M = 0 |
---|
370 | iop1_t_S = 0 |
---|
371 | iop1_t_Sn = 0 |
---|
372 | iop1_t_Sd = 0 |
---|
373 | iop1_ti_YY = 0 |
---|
374 | iop1_ti_MM = 0 |
---|
375 | iop1_ti_DD = 0 |
---|
376 | iop1_ti_H = 0 |
---|
377 | iop1_ti_M = 0 |
---|
378 | iop1_ti_S = 0 |
---|
379 | iop1_ti_Sn = 0 |
---|
380 | iop1_ti_Sd = 0 |
---|
381 | iop2_t_YY = 0 |
---|
382 | iop2_t_MM = 1 !see above |
---|
383 | iop2_t_DD = 1 !see above |
---|
384 | iop2_t_H = 0 |
---|
385 | iop2_t_M = 0 |
---|
386 | iop2_t_S = 0 |
---|
387 | iop2_t_Sn = 0 |
---|
388 | iop2_t_Sd = 0 |
---|
389 | iop2_ti_YY = 0 |
---|
390 | iop2_ti_MM = 0 |
---|
391 | iop2_ti_DD = 0 |
---|
392 | iop2_ti_H = 0 |
---|
393 | iop2_ti_M = 0 |
---|
394 | iop2_ti_S = 0 |
---|
395 | iop2_ti_Sn = 0 |
---|
396 | iop2_ti_Sd = 0 |
---|
397 | ires_t_YY = 0 |
---|
398 | ires_t_MM = 1 !see above |
---|
399 | ires_t_DD = 1 !see above |
---|
400 | ires_t_H = 0 |
---|
401 | ires_t_M = 0 |
---|
402 | ires_t_S = 0 |
---|
403 | ires_t_Sn = 0 |
---|
404 | ires_t_Sd = 0 |
---|
405 | ires_ti_YY = 0 |
---|
406 | ires_ti_MM = 0 |
---|
407 | ires_ti_DD = 0 |
---|
408 | ires_ti_H = 0 |
---|
409 | ires_ti_M = 0 |
---|
410 | ires_ti_S = 0 |
---|
411 | ires_ti_Sn = 0 |
---|
412 | ires_ti_Sd = 0 |
---|
413 | itestname = '' |
---|
414 | iexpect_error = .FALSE. |
---|
415 | |
---|
416 | IF ( PRESENT( add_op ) ) THEN |
---|
417 | iadd_op = add_op |
---|
418 | isubtract_op = ( .NOT. add_op ) |
---|
419 | ENDIF |
---|
420 | IF ( PRESENT( multiply_op ) ) THEN |
---|
421 | imultiply_op = multiply_op |
---|
422 | idivide_op = ( .NOT. multiply_op ) |
---|
423 | ENDIF |
---|
424 | num_ops = 0 |
---|
425 | IF ( iadd_op ) num_ops = num_ops + 1 |
---|
426 | IF ( isubtract_op ) num_ops = num_ops + 1 |
---|
427 | IF ( imultiply_op ) num_ops = num_ops + 1 |
---|
428 | IF ( idivide_op ) num_ops = num_ops + 1 |
---|
429 | IF ( num_ops /= 1 ) THEN |
---|
430 | CALL wrf_error_fatal( & |
---|
431 | 'ERROR test_arithmetic: inconsistent operation' ) |
---|
432 | ENDIF |
---|
433 | IF ( PRESENT( op1_t_YY ) ) iop1_t_YY = op1_t_YY |
---|
434 | IF ( PRESENT( op1_t_MM ) ) iop1_t_MM = op1_t_MM |
---|
435 | IF ( PRESENT( op1_t_DD ) ) iop1_t_DD = op1_t_DD |
---|
436 | IF ( PRESENT( op1_t_H ) ) iop1_t_H = op1_t_H |
---|
437 | IF ( PRESENT( op1_t_M ) ) iop1_t_M = op1_t_M |
---|
438 | IF ( PRESENT( op1_t_S ) ) iop1_t_S = op1_t_S |
---|
439 | IF ( PRESENT( op1_t_Sn ) ) iop1_t_Sn = op1_t_Sn |
---|
440 | IF ( PRESENT( op1_t_Sd ) ) iop1_t_Sd = op1_t_Sd |
---|
441 | IF ( PRESENT( op1_ti_YY ) ) iop1_ti_YY = op1_ti_YY |
---|
442 | IF ( PRESENT( op1_ti_MM ) ) iop1_ti_MM = op1_ti_MM |
---|
443 | IF ( PRESENT( op1_ti_DD ) ) iop1_ti_DD = op1_ti_DD |
---|
444 | IF ( PRESENT( op1_ti_H ) ) iop1_ti_H = op1_ti_H |
---|
445 | IF ( PRESENT( op1_ti_M ) ) iop1_ti_M = op1_ti_M |
---|
446 | IF ( PRESENT( op1_ti_S ) ) iop1_ti_S = op1_ti_S |
---|
447 | IF ( PRESENT( op1_ti_Sn ) ) iop1_ti_Sn = op1_ti_Sn |
---|
448 | IF ( PRESENT( op1_ti_Sd ) ) iop1_ti_Sd = op1_ti_Sd |
---|
449 | IF ( PRESENT( op2_t_YY ) ) iop2_t_YY = op2_t_YY |
---|
450 | IF ( PRESENT( op2_t_MM ) ) iop2_t_MM = op2_t_MM |
---|
451 | IF ( PRESENT( op2_t_DD ) ) iop2_t_DD = op2_t_DD |
---|
452 | IF ( PRESENT( op2_t_H ) ) iop2_t_H = op2_t_H |
---|
453 | IF ( PRESENT( op2_t_M ) ) iop2_t_M = op2_t_M |
---|
454 | IF ( PRESENT( op2_t_S ) ) iop2_t_S = op2_t_S |
---|
455 | IF ( PRESENT( op2_t_Sn ) ) iop2_t_Sn = op2_t_Sn |
---|
456 | IF ( PRESENT( op2_t_Sd ) ) iop2_t_Sd = op2_t_Sd |
---|
457 | IF ( PRESENT( op2_ti_YY ) ) iop2_ti_YY = op2_ti_YY |
---|
458 | IF ( PRESENT( op2_ti_MM ) ) iop2_ti_MM = op2_ti_MM |
---|
459 | IF ( PRESENT( op2_ti_DD ) ) iop2_ti_DD = op2_ti_DD |
---|
460 | IF ( PRESENT( op2_ti_H ) ) iop2_ti_H = op2_ti_H |
---|
461 | IF ( PRESENT( op2_ti_M ) ) iop2_ti_M = op2_ti_M |
---|
462 | IF ( PRESENT( op2_ti_S ) ) iop2_ti_S = op2_ti_S |
---|
463 | IF ( PRESENT( op2_ti_Sn ) ) iop2_ti_Sn = op2_ti_Sn |
---|
464 | IF ( PRESENT( op2_ti_Sd ) ) iop2_ti_Sd = op2_ti_Sd |
---|
465 | IF ( PRESENT( res_t_YY ) ) ires_t_YY = res_t_YY |
---|
466 | IF ( PRESENT( res_t_MM ) ) ires_t_MM = res_t_MM |
---|
467 | IF ( PRESENT( res_t_DD ) ) ires_t_DD = res_t_DD |
---|
468 | IF ( PRESENT( res_t_H ) ) ires_t_H = res_t_H |
---|
469 | IF ( PRESENT( res_t_M ) ) ires_t_M = res_t_M |
---|
470 | IF ( PRESENT( res_t_S ) ) ires_t_S = res_t_S |
---|
471 | IF ( PRESENT( res_t_Sn ) ) ires_t_Sn = res_t_Sn |
---|
472 | IF ( PRESENT( res_t_Sd ) ) ires_t_Sd = res_t_Sd |
---|
473 | IF ( PRESENT( res_ti_YY ) ) ires_ti_YY = res_ti_YY |
---|
474 | IF ( PRESENT( res_ti_MM ) ) ires_ti_MM = res_ti_MM |
---|
475 | IF ( PRESENT( res_ti_DD ) ) ires_ti_DD = res_ti_DD |
---|
476 | IF ( PRESENT( res_ti_H ) ) ires_ti_H = res_ti_H |
---|
477 | IF ( PRESENT( res_ti_M ) ) ires_ti_M = res_ti_M |
---|
478 | IF ( PRESENT( res_ti_S ) ) ires_ti_S = res_ti_S |
---|
479 | IF ( PRESENT( res_ti_Sn ) ) ires_ti_Sn = res_ti_Sn |
---|
480 | IF ( PRESENT( res_ti_Sd ) ) ires_ti_Sd = res_ti_Sd |
---|
481 | IF ( PRESENT( testname ) ) itestname = TRIM(testname) |
---|
482 | IF ( PRESENT( expect_error ) ) iexpect_error = expect_error |
---|
483 | |
---|
484 | ! Ensure that optional arguments are consistent... |
---|
485 | op1_is_t = ( PRESENT( op1_t_YY ) .OR. PRESENT( op1_t_MM ) .OR. & |
---|
486 | PRESENT( op1_t_DD ) .OR. PRESENT( op1_t_H ) .OR. & |
---|
487 | PRESENT( op1_t_M ) .OR. PRESENT( op1_t_S ) .OR. & |
---|
488 | PRESENT( op1_t_Sn ) .OR. PRESENT( op1_t_Sd ) ) |
---|
489 | op1_is_ti = ( PRESENT( op1_ti_YY ) .OR. PRESENT( op1_ti_MM ) .OR. & |
---|
490 | PRESENT( op1_ti_DD ) .OR. PRESENT( op1_ti_H ) .OR. & |
---|
491 | PRESENT( op1_ti_M ) .OR. PRESENT( op1_ti_S ) .OR. & |
---|
492 | PRESENT( op1_ti_Sn ) .OR. PRESENT( op1_ti_Sd ) ) |
---|
493 | op2_is_t = ( PRESENT( op2_t_YY ) .OR. PRESENT( op2_t_MM ) .OR. & |
---|
494 | PRESENT( op2_t_DD ) .OR. PRESENT( op2_t_H ) .OR. & |
---|
495 | PRESENT( op2_t_M ) .OR. PRESENT( op2_t_S ) .OR. & |
---|
496 | PRESENT( op2_t_Sn ) .OR. PRESENT( op2_t_Sd ) ) |
---|
497 | op2_is_ti = ( PRESENT( op2_ti_YY ) .OR. PRESENT( op2_ti_MM ) .OR. & |
---|
498 | PRESENT( op2_ti_DD ) .OR. PRESENT( op2_ti_H ) .OR. & |
---|
499 | PRESENT( op2_ti_M ) .OR. PRESENT( op2_ti_S ) .OR. & |
---|
500 | PRESENT( op2_ti_Sn ) .OR. PRESENT( op2_ti_Sd ) ) |
---|
501 | op2_is_int = ( PRESENT( op2_int ) ) |
---|
502 | res_is_t = ( PRESENT( res_t_YY ) .OR. PRESENT( res_t_MM ) .OR. & |
---|
503 | PRESENT( res_t_DD ) .OR. PRESENT( res_t_H ) .OR. & |
---|
504 | PRESENT( res_t_M ) .OR. PRESENT( res_t_S ) .OR. & |
---|
505 | PRESENT( res_t_Sn ) .OR. PRESENT( res_t_Sd ) ) |
---|
506 | res_is_ti = ( PRESENT( res_ti_YY ) .OR. PRESENT( res_ti_MM ) .OR. & |
---|
507 | PRESENT( res_ti_DD ) .OR. PRESENT( res_ti_H ) .OR. & |
---|
508 | PRESENT( res_ti_M ) .OR. PRESENT( res_ti_S ) .OR. & |
---|
509 | PRESENT( res_ti_Sn ) .OR. PRESENT( res_ti_Sd ) ) |
---|
510 | IF ( op1_is_t .EQV. op1_is_ti ) THEN |
---|
511 | CALL wrf_error_fatal( & |
---|
512 | 'ERROR test_arithmetic: inconsistent args for op1' ) |
---|
513 | ENDIF |
---|
514 | num_op2 = 0 |
---|
515 | IF ( op2_is_t ) num_op2 = num_op2 + 1 |
---|
516 | IF ( op2_is_ti ) num_op2 = num_op2 + 1 |
---|
517 | IF ( op2_is_int ) num_op2 = num_op2 + 1 |
---|
518 | IF ( num_op2 /= 1 ) THEN |
---|
519 | CALL wrf_error_fatal( & |
---|
520 | 'ERROR test_arithmetic: inconsistent args for op2' ) |
---|
521 | ENDIF |
---|
522 | IF ( res_is_t .EQV. res_is_ti ) THEN |
---|
523 | CALL wrf_error_fatal( & |
---|
524 | 'ERROR test_arithmetic: inconsistent args for result' ) |
---|
525 | ENDIF |
---|
526 | |
---|
527 | ! Initialize op1 |
---|
528 | IF ( op1_is_t ) THEN |
---|
529 | op1_type_str = 'ESMF_Time' |
---|
530 | CALL WRFU_TimeSet( op1_t, YY=iop1_t_YY, MM=iop1_t_MM, DD=iop1_t_DD , & |
---|
531 | H=iop1_t_H, M=iop1_t_M, S=iop1_t_S, Sn=iop1_t_Sn, Sd=iop1_t_Sd, rc=rc ) |
---|
532 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
533 | TRIM(itestname)//'WRFU_TimeSet() ', & |
---|
534 | __FILE__ , & |
---|
535 | __LINE__ ) |
---|
536 | CALL WRFU_TimeGet( op1_t, timeString=op1_str, rc=rc ) |
---|
537 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
538 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
539 | __FILE__ , & |
---|
540 | __LINE__ ) |
---|
541 | ! handle fractions |
---|
542 | CALL fraction_to_stringi8( op1_t%basetime%Sn, & |
---|
543 | op1_t%basetime%Sd, frac_str ) |
---|
544 | op1_str = TRIM(op1_str)//TRIM(frac_str) |
---|
545 | ELSE |
---|
546 | op1_type_str = 'ESMF_TimeInterval' |
---|
547 | CALL WRFU_TimeIntervalSet( op1_ti, YY=iop1_ti_YY, MM=iop1_ti_MM, & |
---|
548 | D=iop1_ti_DD , & |
---|
549 | H=iop1_ti_H, M=iop1_ti_M, & |
---|
550 | S=iop1_ti_S, Sn=iop1_ti_Sn, Sd=iop1_ti_Sd, rc=rc ) |
---|
551 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
552 | TRIM(itestname)//'WRFU_TimeIntervalSet() ', & |
---|
553 | __FILE__ , & |
---|
554 | __LINE__ ) |
---|
555 | CALL WRFU_TimeIntervalGet( op1_ti, timeString=op1_str, rc=rc ) |
---|
556 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
557 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
558 | __FILE__ , & |
---|
559 | __LINE__ ) |
---|
560 | ! handle fractions |
---|
561 | CALL fraction_to_stringi8( op1_ti%basetime%Sn, & |
---|
562 | op1_ti%basetime%Sd, frac_str ) |
---|
563 | op1_str = TRIM(op1_str)//TRIM(frac_str) |
---|
564 | ENDIF |
---|
565 | ! Initialize op2 |
---|
566 | IF ( op2_is_t ) THEN |
---|
567 | op2_type_str = 'ESMF_Time' |
---|
568 | CALL WRFU_TimeSet( op2_t, YY=iop2_t_YY, MM=iop2_t_MM, DD=iop2_t_DD , & |
---|
569 | H=iop2_t_H, M=iop2_t_M, S=iop2_t_S, Sn=iop2_t_Sn, Sd=iop2_t_Sd, rc=rc ) |
---|
570 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
571 | TRIM(itestname)//'WRFU_TimeSet() ', & |
---|
572 | __FILE__ , & |
---|
573 | __LINE__ ) |
---|
574 | CALL WRFU_TimeGet( op2_t, timeString=op2_str, rc=rc ) |
---|
575 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
576 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
577 | __FILE__ , & |
---|
578 | __LINE__ ) |
---|
579 | ! handle fractions |
---|
580 | CALL fraction_to_stringi8( op2_t%basetime%Sn, & |
---|
581 | op2_t%basetime%Sd, frac_str ) |
---|
582 | op2_str = TRIM(op2_str)//TRIM(frac_str) |
---|
583 | ELSE IF ( op2_is_ti ) THEN |
---|
584 | op2_type_str = 'ESMF_TimeInterval' |
---|
585 | CALL WRFU_TimeIntervalSet( op2_ti, YY=iop2_ti_YY, MM=iop2_ti_MM, & |
---|
586 | D=iop2_ti_DD , & |
---|
587 | H=iop2_ti_H, M=iop2_ti_M, & |
---|
588 | S=iop2_ti_S, Sn=iop2_ti_Sn, Sd=iop2_ti_Sd, rc=rc ) |
---|
589 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
590 | TRIM(itestname)//'WRFU_TimeIntervalSet() ', & |
---|
591 | __FILE__ , & |
---|
592 | __LINE__ ) |
---|
593 | CALL WRFU_TimeIntervalGet( op2_ti, timeString=op2_str, rc=rc ) |
---|
594 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
595 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
596 | __FILE__ , & |
---|
597 | __LINE__ ) |
---|
598 | ! handle fractions |
---|
599 | CALL fraction_to_stringi8( op2_ti%basetime%Sn, & |
---|
600 | op2_ti%basetime%Sd, frac_str ) |
---|
601 | op2_str = TRIM(op2_str)//TRIM(frac_str) |
---|
602 | ELSE |
---|
603 | op2_type_str = 'INTEGER' |
---|
604 | IF ( op2_int > 0 ) THEN |
---|
605 | WRITE(op2_type_str,FMT="('+',I8.8)") ABS(op2_int) |
---|
606 | ELSE |
---|
607 | WRITE(op2_type_str,FMT="('-',I8.8)") ABS(op2_int) |
---|
608 | ENDIF |
---|
609 | ENDIF |
---|
610 | ! Initialize res |
---|
611 | IF ( res_is_t ) THEN |
---|
612 | res_type_str = 'ESMF_Time' |
---|
613 | CALL WRFU_TimeSet( res_t, YY=ires_t_YY, MM=ires_t_MM, DD=ires_t_DD , & |
---|
614 | H=ires_t_H, M=ires_t_M, S=ires_t_S, Sn=ires_t_Sn, Sd=ires_t_Sd, rc=rc ) |
---|
615 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
616 | TRIM(itestname)//'WRFU_TimeSet() ', & |
---|
617 | __FILE__ , & |
---|
618 | __LINE__ ) |
---|
619 | CALL WRFU_TimeGet( res_t, timeString=res_str, rc=rc ) |
---|
620 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
621 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
622 | __FILE__ , & |
---|
623 | __LINE__ ) |
---|
624 | ! handle fractions |
---|
625 | CALL fraction_to_stringi8( res_t%basetime%Sn, & |
---|
626 | res_t%basetime%Sd, frac_str ) |
---|
627 | res_str = TRIM(res_str)//TRIM(frac_str) |
---|
628 | ELSE |
---|
629 | res_type_str = 'ESMF_TimeInterval' |
---|
630 | CALL WRFU_TimeIntervalSet( res_ti, YY=ires_ti_YY, MM=ires_ti_MM, & |
---|
631 | D=ires_ti_DD , & |
---|
632 | H=ires_ti_H, M=ires_ti_M, & |
---|
633 | S=ires_ti_S, Sn=ires_ti_Sn, Sd=ires_ti_Sd, rc=rc ) |
---|
634 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
635 | TRIM(itestname)//'WRFU_TimeIntervalSet() ', & |
---|
636 | __FILE__ , & |
---|
637 | __LINE__ ) |
---|
638 | CALL WRFU_TimeIntervalGet( res_ti, timeString=res_str, rc=rc ) |
---|
639 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
640 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
641 | __FILE__ , & |
---|
642 | __LINE__ ) |
---|
643 | ! handle fractions |
---|
644 | CALL fraction_to_stringi8( res_ti%basetime%Sn, & |
---|
645 | res_ti%basetime%Sd, frac_str ) |
---|
646 | res_str = TRIM(res_str)//TRIM(frac_str) |
---|
647 | ENDIF |
---|
648 | |
---|
649 | ! perform requested operation |
---|
650 | unsupported_op = .FALSE. |
---|
651 | ! modify behavior of wrf_error_fatal for operator being tested |
---|
652 | IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .TRUE. |
---|
653 | ! add |
---|
654 | IF ( iadd_op ) THEN |
---|
655 | op_str = '+' |
---|
656 | IF ( res_is_t ) THEN ! result is ESMF_Time |
---|
657 | IF ( op1_is_t .AND. op2_is_ti ) THEN |
---|
658 | ! ESMF_Time = ESMF_Time + ESMF_TimeInterval |
---|
659 | computed_t = op1_t + op2_ti |
---|
660 | ELSE IF ( op1_is_ti .AND. op2_is_t ) THEN |
---|
661 | ! ESMF_Time = ESMF_TimeInterval + ESMF_Time |
---|
662 | computed_t = op1_ti + op2_t |
---|
663 | ELSE |
---|
664 | unsupported_op = .TRUE. |
---|
665 | ENDIF |
---|
666 | ELSE ! result is ESMF_TimeInterval |
---|
667 | IF ( op1_is_ti .AND. op2_is_ti ) THEN |
---|
668 | ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval |
---|
669 | computed_ti = op1_ti + op2_ti |
---|
670 | ELSE |
---|
671 | unsupported_op = .TRUE. |
---|
672 | ENDIF |
---|
673 | ENDIF |
---|
674 | ! subtract |
---|
675 | ELSE IF ( isubtract_op ) THEN |
---|
676 | op_str = '-' |
---|
677 | IF ( res_is_t ) THEN ! result is ESMF_Time |
---|
678 | IF ( op1_is_t .AND. op2_is_ti ) THEN |
---|
679 | ! ESMF_Time = ESMF_Time - ESMF_TimeInterval |
---|
680 | computed_t = op1_t - op2_ti |
---|
681 | ELSE |
---|
682 | unsupported_op = .TRUE. |
---|
683 | ENDIF |
---|
684 | ELSE ! result is ESMF_TimeInterval |
---|
685 | IF ( op1_is_t .AND. op2_is_t ) THEN |
---|
686 | ! ESMF_TimeInterval = ESMF_Time - ESMF_Time |
---|
687 | computed_ti = op1_t - op2_t |
---|
688 | ELSE IF ( op1_is_ti .AND. op2_is_ti ) THEN |
---|
689 | ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval |
---|
690 | computed_ti = op1_ti - op2_ti |
---|
691 | ELSE |
---|
692 | unsupported_op = .TRUE. |
---|
693 | ENDIF |
---|
694 | ENDIF |
---|
695 | ELSE IF ( imultiply_op ) THEN |
---|
696 | op_str = '*' |
---|
697 | IF ( res_is_ti ) THEN ! result is ESMF_TimeInterval |
---|
698 | IF ( op1_is_ti .AND. op2_is_int ) THEN |
---|
699 | ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER |
---|
700 | computed_ti = op1_ti * op2_int |
---|
701 | ELSE |
---|
702 | unsupported_op = .TRUE. |
---|
703 | ENDIF |
---|
704 | ENDIF |
---|
705 | ELSE IF ( idivide_op ) THEN |
---|
706 | op_str = '/' |
---|
707 | IF ( res_is_ti ) THEN ! result is ESMF_TimeInterval |
---|
708 | IF ( op1_is_ti .AND. op2_is_int ) THEN |
---|
709 | ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER |
---|
710 | computed_ti = op1_ti / op2_int |
---|
711 | ELSE |
---|
712 | unsupported_op = .TRUE. |
---|
713 | ENDIF |
---|
714 | ENDIF |
---|
715 | ENDIF |
---|
716 | ! restore default behavior of wrf_error_fatal |
---|
717 | IF ( iexpect_error ) WRF_ERROR_FATAL_PRINT = .FALSE. |
---|
718 | IF ( unsupported_op ) THEN |
---|
719 | WRITE(str,*) 'ERROR test_arithmetic ',TRIM(itestname), & |
---|
720 | ': unsupported operation (', & |
---|
721 | TRIM(res_type_str),' = ',TRIM(op1_type_str),' ',TRIM(op_str),' ', & |
---|
722 | TRIM(op2_type_str),')' |
---|
723 | CALL wrf_error_fatal( str ) |
---|
724 | ENDIF |
---|
725 | |
---|
726 | ! check result |
---|
727 | test_passed = .FALSE. |
---|
728 | IF ( res_is_t ) THEN ! result is ESMF_Time |
---|
729 | IF ( computed_t == res_t ) THEN |
---|
730 | test_passed = .TRUE. |
---|
731 | ELSE |
---|
732 | CALL WRFU_TimeGet( computed_t, timeString=computed_str, rc=rc ) |
---|
733 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
734 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
735 | __FILE__ , & |
---|
736 | __LINE__ ) |
---|
737 | ! handle fractions |
---|
738 | CALL fraction_to_stringi8( computed_t%basetime%Sn, & |
---|
739 | computed_t%basetime%Sd, frac_str ) |
---|
740 | computed_str = TRIM(computed_str)//TRIM(frac_str) |
---|
741 | ENDIF |
---|
742 | ELSE ! result is ESMF_TimeInterval |
---|
743 | IF ( computed_ti == res_ti ) THEN |
---|
744 | test_passed = .TRUE. |
---|
745 | ELSE |
---|
746 | CALL WRFU_TimeIntervalGet( computed_ti, timeString=computed_str, rc=rc ) |
---|
747 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
748 | TRIM(itestname)//'WRFU_TimeGet() ', & |
---|
749 | __FILE__ , & |
---|
750 | __LINE__ ) |
---|
751 | ! handle fractions |
---|
752 | CALL fraction_to_stringi8( computed_ti%basetime%Sn, & |
---|
753 | computed_ti%basetime%Sd, frac_str ) |
---|
754 | computed_str = TRIM(computed_str)//TRIM(frac_str) |
---|
755 | ENDIF |
---|
756 | ENDIF |
---|
757 | IF ( test_passed ) THEN |
---|
758 | WRITE(*,FMT='(A)') 'PASS: '//TRIM(itestname) |
---|
759 | ELSE |
---|
760 | WRITE(*,*) 'FAIL: ',TRIM(itestname),': (', & |
---|
761 | TRIM(res_type_str),' = ',TRIM(op1_type_str),' ',TRIM(op_str),' ', & |
---|
762 | TRIM(op2_type_str),') expected ', & |
---|
763 | TRIM(res_str),' = ',TRIM(op1_str),' ',TRIM(op_str),' ', & |
---|
764 | TRIM(op2_str),' but computed ',TRIM(computed_str) |
---|
765 | ENDIF |
---|
766 | |
---|
767 | END SUBROUTINE test_arithmetic |
---|
768 | |
---|
769 | |
---|
770 | |
---|
771 | ! Test adjust_io_timestr |
---|
772 | SUBROUTINE test_adjust_io_timestr( TI_h, TI_m, TI_s, & |
---|
773 | CT_yy, CT_mm, CT_dd, CT_h, CT_m, CT_s, & |
---|
774 | ST_yy, ST_mm, ST_dd, ST_h, ST_m, ST_s, & |
---|
775 | res_str, testname ) |
---|
776 | INTEGER, INTENT(IN) :: TI_H |
---|
777 | INTEGER, INTENT(IN) :: TI_M |
---|
778 | INTEGER, INTENT(IN) :: TI_S |
---|
779 | INTEGER, INTENT(IN) :: CT_YY |
---|
780 | INTEGER, INTENT(IN) :: CT_MM ! month |
---|
781 | INTEGER, INTENT(IN) :: CT_DD ! day of month |
---|
782 | INTEGER, INTENT(IN) :: CT_H |
---|
783 | INTEGER, INTENT(IN) :: CT_M |
---|
784 | INTEGER, INTENT(IN) :: CT_S |
---|
785 | INTEGER, INTENT(IN) :: ST_YY |
---|
786 | INTEGER, INTENT(IN) :: ST_MM ! month |
---|
787 | INTEGER, INTENT(IN) :: ST_DD ! day of month |
---|
788 | INTEGER, INTENT(IN) :: ST_H |
---|
789 | INTEGER, INTENT(IN) :: ST_M |
---|
790 | INTEGER, INTENT(IN) :: ST_S |
---|
791 | CHARACTER (LEN=*), INTENT(IN) :: res_str |
---|
792 | CHARACTER (LEN=*), INTENT(IN) :: testname |
---|
793 | ! locals |
---|
794 | TYPE(WRFU_TimeInterval) :: TI |
---|
795 | TYPE(WRFU_Time) :: CT, ST |
---|
796 | LOGICAL :: test_passed |
---|
797 | INTEGER :: rc |
---|
798 | CHARACTER(LEN=WRFU_MAXSTR) :: TI_str, CT_str, ST_str, computed_str |
---|
799 | ! TI |
---|
800 | CALL WRFU_TimeIntervalSet( TI, H=TI_H, M=TI_M, S=TI_S, rc=rc ) |
---|
801 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
802 | TRIM(testname)//'WRFU_TimeIntervalSet() ', & |
---|
803 | __FILE__ , & |
---|
804 | __LINE__ ) |
---|
805 | CALL WRFU_TimeIntervalGet( TI, timeString=TI_str, rc=rc ) |
---|
806 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
807 | TRIM(testname)//'WRFU_TimeGet() ', & |
---|
808 | __FILE__ , & |
---|
809 | __LINE__ ) |
---|
810 | ! CT |
---|
811 | CALL WRFU_TimeSet( CT, YY=CT_YY, MM=CT_MM, DD=CT_DD , & |
---|
812 | H=CT_H, M=CT_M, S=CT_S, rc=rc ) |
---|
813 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
814 | TRIM(testname)//'WRFU_TimeSet() ', & |
---|
815 | __FILE__ , & |
---|
816 | __LINE__ ) |
---|
817 | CALL WRFU_TimeGet( CT, timeString=CT_str, rc=rc ) |
---|
818 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
819 | TRIM(testname)//'WRFU_TimeGet() ', & |
---|
820 | __FILE__ , & |
---|
821 | __LINE__ ) |
---|
822 | ! ST |
---|
823 | CALL WRFU_TimeSet( ST, YY=ST_YY, MM=ST_MM, DD=ST_DD , & |
---|
824 | H=ST_H, M=ST_M, S=ST_S, rc=rc ) |
---|
825 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
826 | TRIM(testname)//'WRFU_TimeSet() ', & |
---|
827 | __FILE__ , & |
---|
828 | __LINE__ ) |
---|
829 | CALL WRFU_TimeGet( ST, timeString=ST_str, rc=rc ) |
---|
830 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
831 | TRIM(testname)//'WRFU_TimeGet() ', & |
---|
832 | __FILE__ , & |
---|
833 | __LINE__ ) |
---|
834 | |
---|
835 | ! Test |
---|
836 | CALL adjust_io_timestr ( TI, CT, ST, computed_str ) |
---|
837 | |
---|
838 | ! check result |
---|
839 | test_passed = .FALSE. |
---|
840 | IF ( LEN_TRIM(res_str) == LEN_TRIM(computed_str) ) THEN |
---|
841 | IF ( res_str(1:LEN_TRIM(res_str)) == computed_str(1:LEN_TRIM(computed_str)) ) THEN |
---|
842 | test_passed = .TRUE. |
---|
843 | ENDIF |
---|
844 | ENDIF |
---|
845 | |
---|
846 | ! print result |
---|
847 | IF ( test_passed ) THEN |
---|
848 | WRITE(*,FMT='(A)') 'PASS: '//TRIM(testname) |
---|
849 | ELSE |
---|
850 | WRITE(*,*) 'FAIL: ',TRIM(testname),': adjust_io_timestr(', & |
---|
851 | TRIM(TI_str),',',TRIM(CT_str),',',TRIM(ST_str),') expected <', & |
---|
852 | TRIM(res_str),'> but computed <',TRIM(computed_str),'>' |
---|
853 | ENDIF |
---|
854 | |
---|
855 | END SUBROUTINE test_adjust_io_timestr |
---|
856 | |
---|
857 | |
---|
858 | |
---|
859 | ! simple clock creation and advance with add-subtract tests thrown in |
---|
860 | ! no self checks (yet) |
---|
861 | SUBROUTINE test_clock_advance( & |
---|
862 | start_yy, start_mm, start_dd, start_h, start_m, start_s, & |
---|
863 | stop_yy, stop_mm, stop_dd, stop_h, stop_m, stop_s, & |
---|
864 | timestep_d, timestep_h, timestep_m, timestep_s, timestep_sn, timestep_sd, & |
---|
865 | testname, increment_S, increment_Sn, increment_Sd ) |
---|
866 | INTEGER, INTENT(IN), OPTIONAL :: start_YY |
---|
867 | INTEGER, INTENT(IN), OPTIONAL :: start_MM ! month |
---|
868 | INTEGER, INTENT(IN), OPTIONAL :: start_DD ! day of month |
---|
869 | INTEGER, INTENT(IN), OPTIONAL :: start_H |
---|
870 | INTEGER, INTENT(IN), OPTIONAL :: start_M |
---|
871 | INTEGER, INTENT(IN), OPTIONAL :: start_S |
---|
872 | INTEGER, INTENT(IN), OPTIONAL :: stop_YY |
---|
873 | INTEGER, INTENT(IN), OPTIONAL :: stop_MM ! month |
---|
874 | INTEGER, INTENT(IN), OPTIONAL :: stop_DD ! day of month |
---|
875 | INTEGER, INTENT(IN), OPTIONAL :: stop_H |
---|
876 | INTEGER, INTENT(IN), OPTIONAL :: stop_M |
---|
877 | INTEGER, INTENT(IN), OPTIONAL :: stop_S |
---|
878 | INTEGER, INTENT(IN), OPTIONAL :: timestep_D ! day |
---|
879 | INTEGER, INTENT(IN), OPTIONAL :: timestep_H |
---|
880 | INTEGER, INTENT(IN), OPTIONAL :: timestep_M |
---|
881 | INTEGER, INTENT(IN), OPTIONAL :: timestep_S |
---|
882 | INTEGER, INTENT(IN), OPTIONAL :: timestep_Sn |
---|
883 | INTEGER, INTENT(IN), OPTIONAL :: timestep_Sd |
---|
884 | CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: testname |
---|
885 | INTEGER, INTENT(IN), OPTIONAL :: increment_S ! add and subtract this |
---|
886 | INTEGER, INTENT(IN), OPTIONAL :: increment_Sn ! value each time step |
---|
887 | INTEGER, INTENT(IN), OPTIONAL :: increment_Sd |
---|
888 | |
---|
889 | ! locals |
---|
890 | INTEGER :: istart_YY |
---|
891 | INTEGER :: istart_MM ! month |
---|
892 | INTEGER :: istart_DD ! day of month |
---|
893 | INTEGER :: istart_H |
---|
894 | INTEGER :: istart_M |
---|
895 | INTEGER :: istart_S |
---|
896 | INTEGER :: istop_YY |
---|
897 | INTEGER :: istop_MM ! month |
---|
898 | INTEGER :: istop_DD ! day of month |
---|
899 | INTEGER :: istop_H |
---|
900 | INTEGER :: istop_M |
---|
901 | INTEGER :: istop_S |
---|
902 | INTEGER :: itimestep_D ! day |
---|
903 | INTEGER :: itimestep_H |
---|
904 | INTEGER :: itimestep_M |
---|
905 | INTEGER :: itimestep_S |
---|
906 | INTEGER :: itimestep_Sn |
---|
907 | INTEGER :: itimestep_Sd |
---|
908 | CHARACTER (LEN=512) :: itestname, itestfullname |
---|
909 | INTEGER :: iincrement_S |
---|
910 | INTEGER :: iincrement_Sn |
---|
911 | INTEGER :: iincrement_Sd |
---|
912 | INTEGER rc |
---|
913 | TYPE(WRFU_Time) :: start_time, stop_time, current_time |
---|
914 | TYPE(WRFU_Clock), POINTER :: domain_clock |
---|
915 | TYPE(WRFU_TimeInterval) :: timestep, increment |
---|
916 | TYPE(WRFU_Time) :: add_time, subtract_time |
---|
917 | INTEGER :: itimestep |
---|
918 | CHARACTER(LEN=WRFU_MAXSTR) :: str, frac_str |
---|
919 | |
---|
920 | istart_YY = 0 |
---|
921 | istart_MM = 1 !see above |
---|
922 | istart_DD = 1 !see above |
---|
923 | istart_H = 0 |
---|
924 | istart_M = 0 |
---|
925 | istart_S = 0 |
---|
926 | istop_YY = 0 |
---|
927 | istop_MM = 1 !see above |
---|
928 | istop_DD = 1 !see above |
---|
929 | istop_H = 0 |
---|
930 | istop_M = 0 |
---|
931 | istop_S = 0 |
---|
932 | itimestep_D = 0 |
---|
933 | itimestep_H = 0 |
---|
934 | itimestep_M = 0 |
---|
935 | itimestep_S = 0 |
---|
936 | itimestep_Sn = 0 |
---|
937 | itimestep_Sd = 0 |
---|
938 | itestname = '' |
---|
939 | iincrement_S = 0 |
---|
940 | iincrement_Sn = 0 |
---|
941 | iincrement_Sd = 0 |
---|
942 | |
---|
943 | IF ( PRESENT( start_YY ) ) istart_YY = start_YY |
---|
944 | IF ( PRESENT( start_MM ) ) istart_MM = start_MM |
---|
945 | IF ( PRESENT( start_DD ) ) istart_DD = start_DD |
---|
946 | IF ( PRESENT( start_H ) ) istart_H = start_H |
---|
947 | IF ( PRESENT( start_M ) ) istart_M = start_M |
---|
948 | IF ( PRESENT( start_S ) ) istart_S = start_S |
---|
949 | IF ( PRESENT( stop_YY ) ) istop_YY = stop_YY |
---|
950 | IF ( PRESENT( stop_MM ) ) istop_MM = stop_MM |
---|
951 | IF ( PRESENT( stop_DD ) ) istop_DD = stop_DD |
---|
952 | IF ( PRESENT( stop_H ) ) istop_H = stop_H |
---|
953 | IF ( PRESENT( stop_M ) ) istop_M = stop_M |
---|
954 | IF ( PRESENT( stop_S ) ) istop_S = stop_S |
---|
955 | IF ( PRESENT( timestep_D ) ) itimestep_D = timestep_D |
---|
956 | IF ( PRESENT( timestep_H ) ) itimestep_H = timestep_H |
---|
957 | IF ( PRESENT( timestep_M ) ) itimestep_M = timestep_M |
---|
958 | IF ( PRESENT( timestep_S ) ) itimestep_S = timestep_S |
---|
959 | IF ( PRESENT( timestep_Sn ) ) itimestep_Sn = timestep_Sn |
---|
960 | IF ( PRESENT( timestep_Sd ) ) itimestep_Sd = timestep_Sd |
---|
961 | IF ( PRESENT( testname ) ) itestname = TRIM(testname)//'_' |
---|
962 | IF ( PRESENT( increment_S ) ) iincrement_S = increment_S |
---|
963 | IF ( PRESENT( increment_Sn ) ) iincrement_Sn = increment_Sn |
---|
964 | IF ( PRESENT( increment_Sd ) ) iincrement_Sd = increment_Sd |
---|
965 | |
---|
966 | ! Initialize start time, stop time, time step, clock for simple case. |
---|
967 | itestfullname = TRIM(itestname)//'SETUP' |
---|
968 | CALL WRFU_TimeSet( start_time, YY=istart_YY, MM=istart_MM, DD=istart_DD , & |
---|
969 | H=istart_H, M=istart_M, S=istart_S, rc=rc ) |
---|
970 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
971 | TRIM(itestfullname)//'WRFU_TimeSet() ', & |
---|
972 | __FILE__ , & |
---|
973 | __LINE__ ) |
---|
974 | |
---|
975 | CALL WRFU_TimeGet( start_time, timeString=str, rc=rc ) |
---|
976 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
977 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
978 | __FILE__ , & |
---|
979 | __LINE__ ) |
---|
980 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': start_time = <',TRIM(str),'>' |
---|
981 | |
---|
982 | CALL WRFU_TimeSet( stop_time, YY=istop_YY, MM=istop_MM, DD=istop_DD , & |
---|
983 | H=istop_H, M=istop_M, S=istop_S, rc=rc ) |
---|
984 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
985 | TRIM(itestfullname)//'WRFU_TimeSet() ', & |
---|
986 | __FILE__ , & |
---|
987 | __LINE__ ) |
---|
988 | |
---|
989 | CALL WRFU_TimeGet( stop_time, timeString=str, rc=rc ) |
---|
990 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
991 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
992 | __FILE__ , & |
---|
993 | __LINE__ ) |
---|
994 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': stop_time = <',TRIM(str),'>' |
---|
995 | |
---|
996 | CALL WRFU_TimeIntervalSet( timestep, D=itimestep_D, H=itimestep_H, & |
---|
997 | M=itimestep_M, S=itimestep_S, & |
---|
998 | Sn=itimestep_Sn, Sd=itimestep_Sd, rc=rc ) |
---|
999 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1000 | TRIM(itestfullname)//'WRFU_TimeIntervalSet() ', & |
---|
1001 | __FILE__ , & |
---|
1002 | __LINE__ ) |
---|
1003 | |
---|
1004 | CALL WRFU_TimeIntervalGet( timestep, timeString=str, rc=rc ) |
---|
1005 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1006 | TRIM(itestfullname)//'WRFU_TimeIntervalGet() ', & |
---|
1007 | __FILE__ , & |
---|
1008 | __LINE__ ) |
---|
1009 | ! handle fractions |
---|
1010 | CALL fraction_to_stringi8( timestep%basetime%Sn, & |
---|
1011 | timestep%basetime%Sd, frac_str ) |
---|
1012 | str = TRIM(str)//TRIM(frac_str) |
---|
1013 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': timestep = <',TRIM(str),'>' |
---|
1014 | |
---|
1015 | CALL WRFU_TimeIntervalSet( increment, S=iincrement_S, & |
---|
1016 | Sn=iincrement_Sn, Sd=iincrement_Sd, rc=rc ) |
---|
1017 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1018 | TRIM(itestfullname)//'WRFU_TimeIntervalSet() ', & |
---|
1019 | __FILE__ , & |
---|
1020 | __LINE__ ) |
---|
1021 | |
---|
1022 | CALL WRFU_TimeIntervalGet( increment, timeString=str, rc=rc ) |
---|
1023 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1024 | TRIM(itestfullname)//'WRFU_TimeIntervalGet() ', & |
---|
1025 | __FILE__ , & |
---|
1026 | __LINE__ ) |
---|
1027 | ! handle fractions |
---|
1028 | CALL fraction_to_stringi8( increment%basetime%Sn, & |
---|
1029 | increment%basetime%Sd, frac_str ) |
---|
1030 | str = TRIM(str)//TRIM(frac_str) |
---|
1031 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': increment = <',TRIM(str),'>' |
---|
1032 | |
---|
1033 | ALLOCATE( domain_clock ) |
---|
1034 | domain_clock = WRFU_ClockCreate( TimeStep= timestep, & |
---|
1035 | StartTime=start_time, & |
---|
1036 | StopTime= stop_time, & |
---|
1037 | rc=rc ) |
---|
1038 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1039 | TRIM(itestfullname)//'WRFU_ClockCreate() ', & |
---|
1040 | __FILE__ , & |
---|
1041 | __LINE__ ) |
---|
1042 | |
---|
1043 | CALL WRFU_ClockGet( domain_clock, CurrTime=current_time, & |
---|
1044 | rc=rc ) |
---|
1045 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1046 | TRIM(itestfullname)//'WRFU_ClockGet() ', & |
---|
1047 | __FILE__ , & |
---|
1048 | __LINE__ ) |
---|
1049 | |
---|
1050 | CALL WRFU_TimeGet( current_time, timeString=str, rc=rc ) |
---|
1051 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1052 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1053 | __FILE__ , & |
---|
1054 | __LINE__ ) |
---|
1055 | CALL fraction_to_stringi8( current_time%basetime%Sn, & |
---|
1056 | current_time%basetime%Sd, frac_str ) |
---|
1057 | str = TRIM(str)//TRIM(frac_str) |
---|
1058 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': clock current_time = <',TRIM(str),'>' |
---|
1059 | |
---|
1060 | subtract_time = current_time - increment |
---|
1061 | CALL WRFU_TimeGet( subtract_time, timeString=str, rc=rc ) |
---|
1062 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1063 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1064 | __FILE__ , & |
---|
1065 | __LINE__ ) |
---|
1066 | CALL fraction_to_stringi8( subtract_time%basetime%Sn, & |
---|
1067 | subtract_time%basetime%Sd, frac_str ) |
---|
1068 | str = TRIM(str)//TRIM(frac_str) |
---|
1069 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': current_time-increment = <',TRIM(str),'>' |
---|
1070 | |
---|
1071 | add_time = current_time + increment |
---|
1072 | CALL WRFU_TimeGet( add_time, timeString=str, rc=rc ) |
---|
1073 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1074 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1075 | __FILE__ , & |
---|
1076 | __LINE__ ) |
---|
1077 | CALL fraction_to_stringi8( add_time%basetime%Sn, & |
---|
1078 | add_time%basetime%Sd, frac_str ) |
---|
1079 | str = TRIM(str)//TRIM(frac_str) |
---|
1080 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': current_time+increment = <',TRIM(str),'>' |
---|
1081 | |
---|
1082 | ! Advance clock. |
---|
1083 | itestfullname = TRIM(itestname)//'ADVANCE' |
---|
1084 | itimestep = 0 |
---|
1085 | DO WHILE ( .NOT. WRFU_ClockIsStopTime(domain_clock ,rc=rc) ) |
---|
1086 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1087 | TRIM(itestfullname)//'WRFU_ClockIsStopTime() ', & |
---|
1088 | __FILE__ , & |
---|
1089 | __LINE__ ) |
---|
1090 | itimestep = itimestep + 1 |
---|
1091 | |
---|
1092 | CALL WRFU_ClockAdvance( domain_clock, rc=rc ) |
---|
1093 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1094 | TRIM(itestfullname)//'WRFU_ClockAdvance() ', & |
---|
1095 | __FILE__ , & |
---|
1096 | __LINE__ ) |
---|
1097 | |
---|
1098 | CALL WRFU_ClockGet( domain_clock, CurrTime=current_time, & |
---|
1099 | rc=rc ) |
---|
1100 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1101 | TRIM(itestfullname)//'WRFU_ClockGet() ', & |
---|
1102 | __FILE__ , & |
---|
1103 | __LINE__ ) |
---|
1104 | |
---|
1105 | CALL WRFU_TimeGet( current_time, timeString=str, rc=rc ) |
---|
1106 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1107 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1108 | __FILE__ , & |
---|
1109 | __LINE__ ) |
---|
1110 | CALL fraction_to_stringi8( current_time%basetime%Sn, & |
---|
1111 | current_time%basetime%Sd, frac_str ) |
---|
1112 | str = TRIM(str)//TRIM(frac_str) |
---|
1113 | WRITE(*,FMT='(A,A,I6.6,A,A,A)') TRIM(itestfullname),': count = ', & |
---|
1114 | itimestep,' current_time = <',TRIM(str),'>' |
---|
1115 | |
---|
1116 | subtract_time = current_time - increment |
---|
1117 | CALL WRFU_TimeGet( subtract_time, timeString=str, rc=rc ) |
---|
1118 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1119 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1120 | __FILE__ , & |
---|
1121 | __LINE__ ) |
---|
1122 | CALL fraction_to_stringi8( subtract_time%basetime%Sn, & |
---|
1123 | subtract_time%basetime%Sd, frac_str ) |
---|
1124 | str = TRIM(str)//TRIM(frac_str) |
---|
1125 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': current_time-increment = <',TRIM(str),'>' |
---|
1126 | |
---|
1127 | add_time = current_time + increment |
---|
1128 | CALL WRFU_TimeGet( add_time, timeString=str, rc=rc ) |
---|
1129 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1130 | TRIM(itestfullname)//'WRFU_TimeGet() ', & |
---|
1131 | __FILE__ , & |
---|
1132 | __LINE__ ) |
---|
1133 | CALL fraction_to_stringi8( add_time%basetime%Sn, & |
---|
1134 | add_time%basetime%Sd, frac_str ) |
---|
1135 | str = TRIM(str)//TRIM(frac_str) |
---|
1136 | WRITE(*,FMT='(A,A,A,A)') TRIM(itestfullname),': current_time+increment = <',TRIM(str),'>' |
---|
1137 | |
---|
1138 | ENDDO |
---|
1139 | |
---|
1140 | DEALLOCATE( domain_clock ) |
---|
1141 | |
---|
1142 | END SUBROUTINE test_clock_advance |
---|
1143 | |
---|
1144 | END MODULE my_tests |
---|
1145 | |
---|
1146 | |
---|
1147 | #if defined( ESMF_TIME_F90_ONLY ) |
---|
1148 | |
---|
1149 | ! TBH: Improve the build of Test1.exe to use WRF versions of these |
---|
1150 | ! TBH: routines and remove these hacked-in duplicates!! |
---|
1151 | |
---|
1152 | SUBROUTINE wrf_abort |
---|
1153 | IMPLICIT NONE |
---|
1154 | #if defined( DM_PARALLEL ) && ! defined( STUBMPI ) |
---|
1155 | INCLUDE 'mpif.h' |
---|
1156 | INTEGER ierr |
---|
1157 | CALL mpi_abort(MPI_COMM_WORLD,1,ierr) |
---|
1158 | #else |
---|
1159 | STOP |
---|
1160 | #endif |
---|
1161 | END SUBROUTINE wrf_abort |
---|
1162 | |
---|
1163 | SUBROUTINE wrf_message( str ) |
---|
1164 | IMPLICIT NONE |
---|
1165 | CHARACTER*(*) str |
---|
1166 | #if defined( DM_PARALLEL ) && ! defined( STUBMPI) |
---|
1167 | write(0,*) str |
---|
1168 | #endif |
---|
1169 | print*, str |
---|
1170 | END SUBROUTINE wrf_message |
---|
1171 | |
---|
1172 | ! intentionally write to stderr only |
---|
1173 | SUBROUTINE wrf_message2( str ) |
---|
1174 | IMPLICIT NONE |
---|
1175 | CHARACTER*(*) str |
---|
1176 | write(0,*) str |
---|
1177 | END SUBROUTINE wrf_message2 |
---|
1178 | |
---|
1179 | SUBROUTINE wrf_error_fatal3( file_str, line, str ) |
---|
1180 | USE my_tests |
---|
1181 | IMPLICIT NONE |
---|
1182 | CHARACTER*(*) file_str |
---|
1183 | INTEGER , INTENT (IN) :: line ! only print file and line if line > 0 |
---|
1184 | CHARACTER*(*) str |
---|
1185 | CHARACTER*256 :: line_str |
---|
1186 | write(line_str,'(i6)') line |
---|
1187 | ! special behavior for testing since Fortran cannot catch exceptions |
---|
1188 | IF ( WRF_ERROR_FATAL_PRINT ) THEN |
---|
1189 | ! just print message and continue |
---|
1190 | CALL wrf_message( 'ERROR IN FILE: '//TRIM(file_str)//' LINE: '//TRIM(line_str) ) |
---|
1191 | ELSE |
---|
1192 | ! normal behavior |
---|
1193 | #if defined( DM_PARALLEL ) && ! defined( STUBMPI ) |
---|
1194 | CALL wrf_message( '-------------- FATAL CALLED ---------------' ) |
---|
1195 | ! only print file and line if line is positive |
---|
1196 | IF ( line > 0 ) THEN |
---|
1197 | CALL wrf_message( 'FATAL CALLED FROM FILE: '//file_str//' LINE: '//TRIM(line_str) ) |
---|
1198 | ENDIF |
---|
1199 | CALL wrf_message( str ) |
---|
1200 | CALL wrf_message( '-------------------------------------------' ) |
---|
1201 | #else |
---|
1202 | CALL wrf_message2( '-------------- FATAL CALLED ---------------' ) |
---|
1203 | ! only print file and line if line is positive |
---|
1204 | IF ( line > 0 ) THEN |
---|
1205 | CALL wrf_message( 'FATAL CALLED FROM FILE: '//file_str//' LINE: '//TRIM(line_str) ) |
---|
1206 | ENDIF |
---|
1207 | CALL wrf_message2( str ) |
---|
1208 | CALL wrf_message2( '-------------------------------------------' ) |
---|
1209 | #endif |
---|
1210 | CALL wrf_abort |
---|
1211 | ENDIF |
---|
1212 | END SUBROUTINE wrf_error_fatal3 |
---|
1213 | |
---|
1214 | SUBROUTINE wrf_error_fatal( str ) |
---|
1215 | IMPLICIT NONE |
---|
1216 | CHARACTER*(*) str |
---|
1217 | CALL wrf_error_fatal3 ( ' ', 0, str ) |
---|
1218 | END SUBROUTINE wrf_error_fatal |
---|
1219 | |
---|
1220 | |
---|
1221 | ! Converts an WRFU_Time object into a WRF date-time string. |
---|
1222 | ! The format of the WRF date-time strings is a slight variant on ISO 8601: |
---|
1223 | ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss". |
---|
1224 | SUBROUTINE wrf_timetoa ( time, str ) |
---|
1225 | USE module_utility |
---|
1226 | IMPLICIT NONE |
---|
1227 | TYPE(WRFU_Time), INTENT( IN) :: time |
---|
1228 | CHARACTER (LEN=*), INTENT(OUT) :: str |
---|
1229 | INTEGER rc |
---|
1230 | CHARACTER (LEN=256) :: mess |
---|
1231 | CALL WRFU_TimeGet( time, timeString=str, rc=rc ) |
---|
1232 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1233 | 'WRFU_TimeGet() in wrf_timetoa() FAILED', & |
---|
1234 | __FILE__ , & |
---|
1235 | __LINE__ ) |
---|
1236 | ! change ISO 8601 'T' to WRF '_' |
---|
1237 | str(11:11) = '_' |
---|
1238 | ! WRITE (mess,*) 'DEBUG wrf_timetoa(): returning with str = [',TRIM(str),']' |
---|
1239 | ! CALL wrf_debug ( 150 , mess ) |
---|
1240 | RETURN |
---|
1241 | END SUBROUTINE wrf_timetoa |
---|
1242 | |
---|
1243 | |
---|
1244 | ! This is a test for the adjust_output_times capability in WRF, which is |
---|
1245 | ! implemented with the adjust_io_timestr subroutine, defined in |
---|
1246 | ! share/module_io_domain.F. |
---|
1247 | ! |
---|
1248 | ! If the time manager (including the WRF extension |
---|
1249 | ! WRFU_TimeIntervalDIVQuot, defined as WRFADDITION_TimeIntervalDIVQuot in |
---|
1250 | ! ESMF_TimeInterval.F90) is working properly, it should behave as: |
---|
1251 | ! |
---|
1252 | ! Given: |
---|
1253 | ! |
---|
1254 | ! CT = 2000-01-26_00:00:00 (current time) |
---|
1255 | ! ST = 2000-01-24_12:00:00 (start time) |
---|
1256 | ! TI = 00000_03:00:00 (time interval) |
---|
1257 | ! |
---|
1258 | ! the resulting time string should be: |
---|
1259 | ! |
---|
1260 | ! 2000-01-26_00:00:00 |
---|
1261 | ! |
---|
1262 | ! If CT is perturbed slightly, e.g. 2000-01-26_00:00:03, the resulting |
---|
1263 | ! time string should still be 2000-01-26_00:00:00 |
---|
1264 | ! |
---|
1265 | SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr ) |
---|
1266 | USE module_utility |
---|
1267 | IMPLICIT NONE |
---|
1268 | ! Args |
---|
1269 | TYPE(WRFU_Time), INTENT(IN) :: ST,CT ! domain start and current time |
---|
1270 | TYPE(WRFU_TimeInterval), INTENT(IN) :: TI ! interval |
---|
1271 | CHARACTER*(*), INTENT(INOUT) :: timestr ! returned string |
---|
1272 | ! Local |
---|
1273 | TYPE(WRFU_Time) :: OT |
---|
1274 | TYPE(WRFU_TimeInterval) :: IOI |
---|
1275 | INTEGER :: n |
---|
1276 | |
---|
1277 | IOI = CT-ST ! length of time since starting |
---|
1278 | n = WRFU_TimeIntervalDIVQuot( IOI , TI ) ! number of whole time intervals |
---|
1279 | IOI = TI * n ! amount of time since starting in whole time intervals |
---|
1280 | OT = ST + IOI ! previous nearest time instant |
---|
1281 | CALL wrf_timetoa( OT, timestr ) ! generate string |
---|
1282 | RETURN |
---|
1283 | END SUBROUTINE adjust_io_timestr |
---|
1284 | |
---|
1285 | |
---|
1286 | #endif |
---|
1287 | |
---|
1288 | |
---|
1289 | ! Check to see if expected value == actual value |
---|
1290 | ! If not, print message and exit. |
---|
1291 | SUBROUTINE test_check_error( expected, actual, str, file_str, line ) |
---|
1292 | IMPLICIT NONE |
---|
1293 | INTEGER , INTENT (IN) :: expected |
---|
1294 | INTEGER , INTENT (IN) :: actual |
---|
1295 | CHARACTER*(*) str |
---|
1296 | CHARACTER*(*) file_str |
---|
1297 | INTEGER , INTENT (IN) :: line |
---|
1298 | CHARACTER (LEN=512) :: rc_str |
---|
1299 | CHARACTER (LEN=512) :: str_with_rc |
---|
1300 | IF ( expected .ne. actual ) THEN |
---|
1301 | WRITE (rc_str,*) ' Routine returned error code = ',actual |
---|
1302 | str_with_rc = 'FAIL: '//TRIM(str)//TRIM(rc_str) |
---|
1303 | CALL wrf_error_fatal3( file_str, line, str_with_rc ) |
---|
1304 | ENDIF |
---|
1305 | END SUBROUTINE test_check_error |
---|
1306 | |
---|
1307 | |
---|
1308 | |
---|
1309 | PROGRAM time_manager_test |
---|
1310 | USE module_utility |
---|
1311 | USE my_tests |
---|
1312 | IMPLICIT NONE |
---|
1313 | INTEGER :: rc |
---|
1314 | |
---|
1315 | PRINT *,'BEGIN TEST SUITE' |
---|
1316 | |
---|
1317 | CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc ) |
---|
1318 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1319 | 'WRFU_Initialize() ', & |
---|
1320 | __FILE__ , & |
---|
1321 | __LINE__ ) |
---|
1322 | PRINT *,'DEBUG: back from WRFU_Initialize(), rc = ',rc |
---|
1323 | |
---|
1324 | ! CALL test_print( t_yy, t_mm, t_dd, t_h, t_m, t_s, & |
---|
1325 | ! ti_yy, ti_mm, ti_dd, ti_h, ti_m, ti_s, & |
---|
1326 | ! res_str, testname ) |
---|
1327 | |
---|
1328 | ! Print times |
---|
1329 | ! "vanilla" tests |
---|
1330 | ! PRINT *,'DEBUG: calling 1st test_print()' |
---|
1331 | CALL test_print( t_yy=2025, t_mm=03, t_dd=23, t_h=1, t_m=20, t_s=10, & |
---|
1332 | res_str='2025-03-23_01:20:10', testname='printT_1' ) |
---|
1333 | ! PRINT *,'DEBUG: back from 1st test_print()' |
---|
1334 | CALL test_print( t_yy=2000, t_mm=1, t_dd=1, t_h=0, t_m=0, t_s=0, & |
---|
1335 | res_str='2000-01-01_00:00:00', testname='printT_2' ) |
---|
1336 | CALL test_print( t_yy=2026, t_mm=07, t_dd=74, t_h=23, t_m=36, t_s=90, & |
---|
1337 | res_str='2026-07-74_23:36:90', testname='printT_3' ) |
---|
1338 | CALL test_print( t_yy=2026, t_mm=07, t_dd=75, t_h=23, t_m=36, t_s=90, & |
---|
1339 | res_str='2026-07-75_23:36:90', testname='printT_4' ) |
---|
1340 | ! CALL test_print( t_yy=2004, t_mm=12, t_dd=30, t_h=23, t_m=59, t_s=50, & |
---|
1341 | ! res_str='2004-12-30_23:59:50', testname='printT_5' ) |
---|
1342 | ! CALL test_print( t_yy=2004, t_mm=12, t_dd=31, t_h=23, t_m=59, t_s=50, & |
---|
1343 | ! res_str='2004-12-31_23:59:50', testname='printT_6' ) |
---|
1344 | !!$$$ NOTE that this fails -- need to fix up output string for negative year |
---|
1345 | !! CALL test_print( t_yy=-2004, t_mm=12, t_dd=31, t_h=23, t_m=59, t_s=50, & |
---|
1346 | !! res_str='-2004-12-31_23:59:50', testname='printT_6' ) |
---|
1347 | |
---|
1348 | ! ! these test default behavior of test harness |
---|
1349 | ! CALL test_print( t_s=0, & |
---|
1350 | ! res_str='0000-00-00_00:00:00', testname='printT_D1' ) |
---|
1351 | ! CALL test_print( t_yy=0, & |
---|
1352 | ! res_str='0000-00-00_00:00:00', testname='printT_D2' ) |
---|
1353 | |
---|
1354 | PRINT *,'yeah yeah yeah' |
---|
1355 | |
---|
1356 | |
---|
1357 | ! ! fractions |
---|
1358 | ! CALL test_print( t_yy=2001, t_mm=12, t_dd=3, t_h=1, t_m=20, t_s=10, & |
---|
1359 | ! t_sn=1, t_sd=3, & |
---|
1360 | ! res_str='2001-12-03_01:20:10+01/03', testname='printT_F1' ) |
---|
1361 | ! CALL test_print( t_yy=2001, t_mm=12, t_dd=3, t_h=1, t_m=20, t_s=10, & |
---|
1362 | ! t_sn=4, t_sd=3, & |
---|
1363 | ! res_str='2001-12-03_01:20:11+01/03', testname='printT_F2' ) |
---|
1364 | ! CALL test_print( t_yy=2001, t_mm=12, t_dd=3, t_h=1, t_m=20, t_s=10, & |
---|
1365 | ! t_sn=12, t_sd=3, & |
---|
1366 | ! res_str='2001-12-03_01:20:14', testname='printT_F3' ) |
---|
1367 | ! CALL test_print( t_yy=2001, t_mm=12, t_dd=3, t_h=1, t_m=20, t_s=10, & |
---|
1368 | ! t_sn=-1, t_sd=3, & |
---|
1369 | ! res_str='2001-12-03_01:20:09+02/03', testname='printT_F4' ) |
---|
1370 | |
---|
1371 | ! ERROR, MM out of range |
---|
1372 | !$$$here... fix so this just prints "ERROR: <testname>" in failure case |
---|
1373 | !$$$here... also need "expect_fail" to reverse sense of PASS/FAIL message for |
---|
1374 | !$$$here... tests that should fail |
---|
1375 | ! CALL test_print( t_yy=2001, t_mm=13, t_dd=3, t_h=1, t_m=20, t_s=10, & |
---|
1376 | ! res_str='2002-01-03_01:20:10', testname='printT_E1', expect_error=.TRUE. ) |
---|
1377 | |
---|
1378 | ! Print time intervals |
---|
1379 | ! "vanilla" tests |
---|
1380 | CALL test_print( ti_yy=0, ti_mm=0, ti_dd=0, ti_h=0, ti_m=0, ti_s=0, & |
---|
1381 | res_str='0000000000_000:000:000', testname='printTI_1' ) |
---|
1382 | CALL test_print( ti_yy=0, ti_mm=0, ti_dd=500, ti_h=0, ti_m=0, ti_s=9510, & |
---|
1383 | res_str='0000000500_002:021:010', testname='printTI_2' ) |
---|
1384 | |
---|
1385 | ! ! these test default behavior of test harness |
---|
1386 | ! CALL test_print( ti_s=0, & |
---|
1387 | ! res_str='0000000000_000:000:000', testname='printTI_D1' ) |
---|
1388 | ! CALL test_print( ti_yy=0, & |
---|
1389 | ! res_str='0000000000_000:000:000', testname='printTI_D2' ) |
---|
1390 | |
---|
1391 | ! ! these test negative values |
---|
1392 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=-3, ti_h=-1, ti_m=-20, ti_s=-10, & |
---|
1393 | ! res_str='-0000000003_001:020:010', testname='printTI_N1' ) |
---|
1394 | ! |
---|
1395 | ! ! these test mixed values |
---|
1396 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=-3, ti_h=1, ti_m=20, ti_s=10, & |
---|
1397 | ! res_str='-0000000002_022:039:050', testname='printTI_M1' ) |
---|
1398 | ! |
---|
1399 | ! ! fractions |
---|
1400 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=3, ti_h=1, ti_m=20, ti_s=10, & |
---|
1401 | ! ti_sn=1, ti_sd=3, & |
---|
1402 | ! res_str='0000000003_001:020:010+01/03', testname='printTI_F1' ) |
---|
1403 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=3, ti_h=1, ti_m=20, ti_s=10, & |
---|
1404 | ! ti_sn=5, ti_sd=3, & |
---|
1405 | ! res_str='0000000003_001:020:011+02/03', testname='printTI_F2' ) |
---|
1406 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=-3, ti_h=-1, ti_m=-20, ti_s=-10, & |
---|
1407 | ! ti_sn=-1, ti_sd=3, & |
---|
1408 | ! res_str='-0000000003_001:020:010-01/03', testname='printTI_F3' ) |
---|
1409 | ! CALL test_print( ti_yy=0000, ti_mm=0, ti_dd=-3, ti_h=-1, ti_m=-20, ti_s=-10, & |
---|
1410 | ! ti_sn=1, ti_sd=3, & |
---|
1411 | ! res_str='-0000000003_001:020:009-02/03', testname='printTI_F4' ) |
---|
1412 | ! |
---|
1413 | |
---|
1414 | ! these test non-normalized values |
---|
1415 | ! CALL test_print( ti_yy=2001, ti_mm=1, ti_dd=3, ti_h=1, ti_m=20, ti_s=10, & |
---|
1416 | ! res_str='02001-001-003_001:020:010', testname='printTI_NN1', expect_error=.TRUE. ) |
---|
1417 | ! CALL test_print( ti_yy=2001, ti_mm=12, ti_dd=3, ti_h=1, ti_m=20, ti_s=10, & |
---|
1418 | ! res_str='02002-000-003_001:020:010', testname='printTI_NN2', expect_error=.TRUE. ) |
---|
1419 | ! CALL test_print( ti_yy=2002, ti_mm=5, ti_dd=500, ti_h=0, ti_m=0, ti_s=7270, & |
---|
1420 | ! res_str='02002-005-500_002:001:010', testname='printTI_NN3', expect_error=.TRUE. ) |
---|
1421 | |
---|
1422 | |
---|
1423 | ! CALL test_arithmetic( add_op=, & |
---|
1424 | ! op1_t_yy, op1_t_mm, op1_t_dd, op1_t_h, op1_t_m, op1_t_s, & |
---|
1425 | ! op1_ti_yy, op1_ti_mm, op1_ti_dd, op1_ti_h, op1_ti_m, op1_ti_s, & |
---|
1426 | ! op2_t_yy, op2_t_mm, op2_t_dd, op2_t_h, op2_t_m, op2_t_s, & |
---|
1427 | ! op2_ti_yy, op2_ti_mm, op2_ti_dd, op2_ti_h, op2_ti_m, op2_ti_s, & |
---|
1428 | ! res_t_yy, res_t_mm, res_t_dd, res_t_h, res_t_m, res_t_s, & |
---|
1429 | ! res_ti_yy, res_ti_mm, res_ti_dd, res_ti_h, res_ti_m, res_ti_s, & |
---|
1430 | ! testname ) |
---|
1431 | |
---|
1432 | ! Addition tests |
---|
1433 | ! ESMF_Time = ESMF_Time + ESMF_TimeInterval |
---|
1434 | CALL test_arithmetic( add_op=.TRUE., & |
---|
1435 | op1_t_yy=2026, op1_t_mm=03, op1_t_dd=23, op1_t_h=1, op1_t_m=20, op1_t_s=10, & |
---|
1436 | op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, & |
---|
1437 | res_t_yy=2026, res_t_mm=03, res_t_dd=23, res_t_h=4, res_t_m=30, res_t_s=20, & |
---|
1438 | testname='AddT_T_TI1' ) |
---|
1439 | CALL test_arithmetic( add_op=.TRUE., & |
---|
1440 | op1_t_yy=2001, op1_t_mm=07, op1_t_dd=75, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1441 | op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1442 | res_t_yy=2002, res_t_mm= 1, res_t_dd=1, res_t_h=3, res_t_m=03, res_t_s=10, & |
---|
1443 | testname='AddT_T_TI2' ) |
---|
1444 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1445 | ! op1_t_yy=2003, op1_t_mm=12, op1_t_dd=31, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1446 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1447 | ! res_t_yy=2004, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1448 | ! testname='AddT_T_TI3' ) |
---|
1449 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1450 | ! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=31, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1451 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1452 | ! res_t_yy=2005, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1453 | ! testname='AddT_T_TI4' ) |
---|
1454 | ! ! this case hung after the CCSM contribution |
---|
1455 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1456 | ! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=30, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1457 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1458 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=31, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1459 | ! testname='AddT_T_TI5' ) |
---|
1460 | !! NOTE: CCSM folks need to decide what it means to add "1 month" to Feb. 29. And all the |
---|
1461 | ! other very similar cases. Then, write this unit test! |
---|
1462 | !! CALL test_arithmetic( add_op=.TRUE., & |
---|
1463 | !!! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=31, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1464 | ! op2_ti_yy= 2, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1465 | !! res_t_yy=2007, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1466 | !! testname='AddT_T_TI6' ) |
---|
1467 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1468 | ! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1469 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1470 | ! res_t_yy=2005, res_t_mm=12, res_t_dd=30, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1471 | ! testname='AddT_T_TI7' ) |
---|
1472 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1473 | ! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1474 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1475 | ! res_t_yy=2006, res_t_mm=01, res_t_dd=01, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1476 | ! testname='AddT_T_TI8' ) |
---|
1477 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1478 | ! op1_t_yy=2003, op1_t_mm=12, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1479 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1480 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=29, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1481 | ! testname='AddT_T_TI9' ) |
---|
1482 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1483 | ! op1_t_yy=2003, op1_t_mm=12, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1484 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1485 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=30, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1486 | ! testname='AddT_T_TI10' ) |
---|
1487 | CALL test_arithmetic( add_op=.TRUE., & |
---|
1488 | op1_t_yy=2003, op1_t_mm=03, op1_t_dd=23, op1_t_h=0, op1_t_m=0, op1_t_s=0, & |
---|
1489 | op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=675, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1490 | res_t_yy=2004, res_t_mm=03, res_t_dd=29, res_t_h=4, res_t_m=10, res_t_s=10, & |
---|
1491 | testname='AddT_T_TI11' ) |
---|
1492 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1493 | ! op1_t_yy=2003, op1_t_mm=12, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1494 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=368, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1495 | ! res_t_yy=2005, res_t_mm=01, res_t_dd=01, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1496 | ! testname='AddT_T_TI12' ) |
---|
1497 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1498 | ! op1_t_yy=2004, op1_t_mm=03, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1499 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1500 | ! res_t_yy=2005, res_t_mm=03, res_t_dd=30, res_t_h=8, res_t_m=40, res_t_s=10, & |
---|
1501 | ! testname='AddT_T_TI13' ) |
---|
1502 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1503 | ! op1_t_yy=2004, op1_t_mm=03, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1504 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=365, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, & |
---|
1505 | ! res_t_yy=2005, res_t_mm=03, res_t_dd=31, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1506 | ! testname='AddT_T_TI14' ) |
---|
1507 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1508 | ! op1_t_yy=2004, op1_t_mm=03, op1_t_dd=30, op1_t_h=4, op1_t_m=30, op1_t_s=00, & |
---|
1509 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, & |
---|
1510 | ! res_t_yy=2005, res_t_mm=04, res_t_dd=01, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1511 | ! testname='AddT_T_TI15' ) |
---|
1512 | ! ! ESMF_Time = ESMF_Time + ESMF_TimeInterval with fractions |
---|
1513 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1514 | ! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=31, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1515 | ! op1_t_sn=01, op1_t_sd=03, & |
---|
1516 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1517 | ! op2_ti_sn=01, op2_ti_sd=03, & |
---|
1518 | ! res_t_yy=2005, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1519 | ! res_t_sn=02, res_t_sd=03, & |
---|
1520 | ! testname='AddT_T_TI_F1' ) |
---|
1521 | ! ! this should fail (and does) |
---|
1522 | !! CALL test_arithmetic( add_op=.TRUE., & |
---|
1523 | !! op1_t_yy=2004, op1_t_mm=12, op1_t_dd=31, op1_t_h=22, op1_t_m=30, op1_t_s=00, & |
---|
1524 | !! op1_t_sn=01, op1_t_sd=03, & |
---|
1525 | !! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1526 | !! op2_ti_sn=01, op2_ti_sd=03, & |
---|
1527 | !! res_t_yy=2005, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1528 | !! res_t_sn=01, res_t_sd=03, & |
---|
1529 | !! testname='AddT_T_TI_F2' ) |
---|
1530 | ! ! ESMF_Time = ESMF_TimeInterval + ESMF_Time |
---|
1531 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1532 | ! op1_ti_yy= 0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=3, op1_ti_m=10, op1_ti_s=10, & |
---|
1533 | ! op2_t_yy=2001, op2_t_mm=12, op2_t_dd=3, op2_t_h=1, op2_t_m=20, op2_t_s=10, & |
---|
1534 | ! res_t_yy=2001, res_t_mm=12, res_t_dd=3, res_t_h=4, res_t_m=30, res_t_s=20, & |
---|
1535 | ! testname='AddT_TI_T1' ) |
---|
1536 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1537 | ! op1_ti_yy= 0, op1_ti_mm= 0, op1_ti_dd=0, op1_ti_h=4, op1_ti_m=10, op1_ti_s=10, & |
---|
1538 | ! op2_t_yy=2001, op2_t_mm=12, op2_t_dd=31, op2_t_h=22, op2_t_m=30, op2_t_s=00, & |
---|
1539 | ! res_t_yy=2002, res_t_mm= 1, res_t_dd=1, res_t_h=2, res_t_m=40, res_t_s=10, & |
---|
1540 | ! testname='AddT_TI_T2' ) |
---|
1541 | ! ! ESMF_TimeInterval = ESMF_TimeInterval + ESMF_TimeInterval |
---|
1542 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1543 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, & |
---|
1544 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, & |
---|
1545 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20, & |
---|
1546 | ! testname='AddTI_TI_TI1' ) |
---|
1547 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1548 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, & |
---|
1549 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, & |
---|
1550 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=00, & |
---|
1551 | ! testname='AddTI_TI_TI2' ) |
---|
1552 | ! CALL test_arithmetic( add_op=.TRUE., & |
---|
1553 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-3, op1_ti_h=-1, op1_ti_m=-20, op1_ti_s=-10, & |
---|
1554 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, & |
---|
1555 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20, & |
---|
1556 | ! testname='AddTI_TI_TI3' ) |
---|
1557 | ! |
---|
1558 | |
---|
1559 | ! ! Subtraction tests |
---|
1560 | ! ! ESMF_Time = ESMF_Time - ESMF_TimeInterval |
---|
1561 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1562 | ! op1_t_yy=2001, op1_t_mm=12, op1_t_dd=3, op1_t_h=1, op1_t_m=20, op1_t_s=10, & |
---|
1563 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, & |
---|
1564 | ! res_t_yy=2001, res_t_mm=12, res_t_dd=2, res_t_h=22, res_t_m=10, res_t_s=0, & |
---|
1565 | ! testname='SubtractT_T_TI1' ) |
---|
1566 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1567 | ! op1_t_yy=2005, op1_t_mm=1, op1_t_dd=1, op1_t_h=0, op1_t_m=00, op1_t_s=0, & |
---|
1568 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, & |
---|
1569 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=31, res_t_h=23, res_t_m=59, res_t_s=50, & |
---|
1570 | ! testname='SubtractT_T_TI2' ) |
---|
1571 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1572 | ! op1_t_yy=2004, op1_t_mm=1, op1_t_dd=1, op1_t_h=0, op1_t_m=00, op1_t_s=0, & |
---|
1573 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, & |
---|
1574 | ! res_t_yy=2003, res_t_mm=12, res_t_dd=31, res_t_h=23, res_t_m=59, res_t_s=50, & |
---|
1575 | ! testname='SubtractT_T_TI3' ) |
---|
1576 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1577 | ! op1_t_yy=2003, op1_t_mm=1, op1_t_dd=1, op1_t_h=0, op1_t_m=00, op1_t_s=0, & |
---|
1578 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=10, & |
---|
1579 | ! res_t_yy=2002, res_t_mm=12, res_t_dd=31, res_t_h=23, res_t_m=59, res_t_s=50, & |
---|
1580 | ! testname='SubtractT_T_TI4' ) |
---|
1581 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1582 | ! op1_t_yy=2005, op1_t_mm=04, op1_t_dd=01, op1_t_h=2, op1_t_m=40, op1_t_s=10, & |
---|
1583 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=366, op2_ti_h=22, op2_ti_m=10, op2_ti_s=10, & |
---|
1584 | ! res_t_yy=2004, res_t_mm=03, res_t_dd=30, res_t_h=4, res_t_m=30, res_t_s=00, & |
---|
1585 | ! testname='SubtractT_T_TI5' ) |
---|
1586 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1587 | ! op1_t_yy=2006, op1_t_mm=01, op1_t_dd=01, op1_t_h=8, op1_t_m=40, op1_t_s=10, & |
---|
1588 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=367, op2_ti_h=4, op2_ti_m=10, op2_ti_s=10, & |
---|
1589 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=30, res_t_h=4, res_t_m=30, res_t_s=00, & |
---|
1590 | ! testname='SubtractT_T_TI6' ) |
---|
1591 | ! ! ESMF_Time = ESMF_Time - ESMF_TimeInterval with fractions |
---|
1592 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1593 | ! op1_t_yy=2005, op1_t_mm=01, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1594 | ! op1_t_sn=00, op1_t_sd=00, & |
---|
1595 | ! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=0, op2_ti_m=00, op2_ti_s=01, & |
---|
1596 | ! op2_ti_sn=01, op2_ti_sd=03, & |
---|
1597 | ! res_t_yy=2004, res_t_mm=12, res_t_dd=31, res_t_h=23, res_t_m=59, res_t_s=58, & |
---|
1598 | ! res_t_sn=02, res_t_sd=03, & |
---|
1599 | ! testname='SubtractT_T_TI_F1' ) |
---|
1600 | ! ! ESMF_TimeInterval = ESMF_Time - ESMF_Time |
---|
1601 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1602 | ! op1_t_yy=2001, op1_t_mm=12, op1_t_dd=3, op1_t_h=1, op1_t_m=20, op1_t_s=10, & |
---|
1603 | ! op2_t_yy=2001, op2_t_mm=12, op2_t_dd=1, op2_t_h=1, op2_t_m=10, op2_t_s=10, & |
---|
1604 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0, & |
---|
1605 | ! testname='SubtractTI_T_T1' ) |
---|
1606 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1607 | ! op1_t_yy=2002, op1_t_mm=1, op1_t_dd=1, op1_t_h=0, op1_t_m=00, op1_t_s=00, & |
---|
1608 | ! op2_t_yy=2001, op2_t_mm=12, op2_t_dd=31, op2_t_h=23, op2_t_m=59, op2_t_s=50, & |
---|
1609 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, & |
---|
1610 | ! testname='SubtractTI_T_T2' ) |
---|
1611 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1612 | ! op1_t_yy=2005, op1_t_mm=1, op1_t_dd=1, op1_t_h=0, op1_t_m=00, op1_t_s=00, & |
---|
1613 | ! op2_t_yy=2004, op2_t_mm=12, op2_t_dd=31, op2_t_h=23, op2_t_m=59, op2_t_s=50, & |
---|
1614 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, & |
---|
1615 | ! testname='SubtractTI_T_T3' ) |
---|
1616 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1617 | ! op1_t_yy=2003, op1_t_mm=03, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1618 | ! op2_t_yy=2003, op2_t_mm=02, op2_t_dd=28, op2_t_h=23, op2_t_m=59, op2_t_s=50, & |
---|
1619 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=10, & |
---|
1620 | ! testname='SubtractTI_T_T4' ) |
---|
1621 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1622 | ! op1_t_yy=2004, op1_t_mm=03, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1623 | ! op2_t_yy=2004, op2_t_mm=02, op2_t_dd=28, op2_t_h=23, op2_t_m=59, op2_t_s=50, & |
---|
1624 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=1, res_ti_h=0, res_ti_m=00, res_ti_s=10, & |
---|
1625 | ! testname='SubtractTI_T_T5' ) |
---|
1626 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1627 | ! op1_t_yy=2002, op1_t_mm=02, op1_t_dd=28, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1628 | ! op2_t_yy=2002, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1629 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1630 | ! testname='SubtractTI_T_T6' ) |
---|
1631 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1632 | ! op1_t_yy=2003, op1_t_mm=02, op1_t_dd=28, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1633 | ! op2_t_yy=2002, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1634 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1635 | ! testname='SubtractTI_T_T7' ) |
---|
1636 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1637 | ! op1_t_yy=2004, op1_t_mm=02, op1_t_dd=28, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1638 | ! op2_t_yy=2003, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1639 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=365, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1640 | ! testname='SubtractTI_T_T8' ) |
---|
1641 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1642 | ! op1_t_yy=2005, op1_t_mm=02, op1_t_dd=28, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1643 | ! op2_t_yy=2004, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1644 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1645 | ! testname='SubtractTI_T_T9' ) |
---|
1646 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1647 | ! op1_t_yy=2003, op1_t_mm=03, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1648 | ! op2_t_yy=2002, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1649 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1650 | ! testname='SubtractTI_T_T10' ) |
---|
1651 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1652 | ! op1_t_yy=2005, op1_t_mm=03, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1653 | ! op2_t_yy=2004, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1654 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=367, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1655 | ! testname='SubtractTI_T_T11' ) |
---|
1656 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1657 | ! op1_t_yy=2005, op1_t_mm=03, op1_t_dd=01, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1658 | ! op2_t_yy=2004, op2_t_mm=02, op2_t_dd=28, op2_t_h=23, op2_t_m=59, op2_t_s=50, & |
---|
1659 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=366, res_ti_h=0, res_ti_m=00, res_ti_s=10, & |
---|
1660 | ! testname='SubtractTI_T_T12' ) |
---|
1661 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1662 | ! op1_t_yy=2004, op1_t_mm=02, op1_t_dd=28, op1_t_h=23, op1_t_m=59, op1_t_s=50, & |
---|
1663 | ! op2_t_yy=2005, op2_t_mm=03, op2_t_dd=01, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1664 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-366, res_ti_h=0, res_ti_m=00, res_ti_s=-10, & |
---|
1665 | ! testname='SubtractTI_T_T13' ) |
---|
1666 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1667 | ! op1_t_yy=-2002, op1_t_mm=02, op1_t_dd=28, op1_t_h=00, op1_t_m=00, op1_t_s=00, & |
---|
1668 | ! op2_t_yy=-2002, op2_t_mm=02, op2_t_dd=28, op2_t_h=00, op2_t_m=00, op2_t_s=00, & |
---|
1669 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=0, res_ti_h=0, res_ti_m=00, res_ti_s=00, & |
---|
1670 | ! testname='SubtractTI_T_T14' ) |
---|
1671 | ! ! ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval |
---|
1672 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1673 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, & |
---|
1674 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, & |
---|
1675 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0, & |
---|
1676 | ! testname='SubtractTI_TI_TI1' ) |
---|
1677 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1678 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, & |
---|
1679 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-1, op2_ti_h=-1, op2_ti_m=-10, op2_ti_s=-10, & |
---|
1680 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=4, res_ti_h=2, res_ti_m=30, res_ti_s=20, & |
---|
1681 | ! testname='SubtractTI_TI_TI2' ) |
---|
1682 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1683 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, & |
---|
1684 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=-3, op2_ti_h=-1, op2_ti_m=-20, op2_ti_s=-10, & |
---|
1685 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=00, & |
---|
1686 | ! testname='SubtractTI_TI_TI3' ) |
---|
1687 | ! ! Negative result ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval |
---|
1688 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1689 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=1, op1_ti_h=1, op1_ti_m=10, op1_ti_s=10, & |
---|
1690 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, & |
---|
1691 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-2, res_ti_h=0, res_ti_m=-10, res_ti_s=0, & |
---|
1692 | ! testname='SubtractTI_TI_TIN1' ) |
---|
1693 | ! CALL test_arithmetic( add_op=.FALSE., & |
---|
1694 | ! op1_ti_yy=0000, op1_ti_mm=00, op1_ti_dd=-1, op1_ti_h=-1, op1_ti_m=-10, op1_ti_s=-10, & |
---|
1695 | ! op2_ti_yy=0000, op2_ti_mm=00, op2_ti_dd=3, op2_ti_h=1, op2_ti_m=20, op2_ti_s=10, & |
---|
1696 | ! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=-4, res_ti_h=-2, res_ti_m=-30, res_ti_s=-20, & |
---|
1697 | ! testname='SubtractTI_TI_TIN2' ) |
---|
1698 | ! |
---|
1699 | ! ! Un-normalized ESMF_TimeInterval = ESMF_TimeInterval - ESMF_TimeInterval |
---|
1700 | ! ! this is an error |
---|
1701 | !! CALL test_arithmetic( add_op=.FALSE., & |
---|
1702 | !! op1_ti_yy=2001, op1_ti_mm=11, op1_ti_dd=3, op1_ti_h=1, op1_ti_m=20, op1_ti_s=10, & |
---|
1703 | !! op2_ti_yy=2001, op2_ti_mm=11, op2_ti_dd=1, op2_ti_h=1, op2_ti_m=10, op2_ti_s=10, & |
---|
1704 | !! res_ti_yy=0000, res_ti_mm=00, res_ti_dd=2, res_ti_h=0, res_ti_m=10, res_ti_s=0, & |
---|
1705 | !! testname='SubtractTI_TI_TIU1', expect_error=.TRUE. ) |
---|
1706 | ! |
---|
1707 | ! ! this one should FAIL, and does |
---|
1708 | !! CALL test_arithmetic( add_op=.TRUE., & |
---|
1709 | !! op1_t_yy=2001, op1_t_mm=12, op1_t_dd=3, op1_t_h=1, op1_t_m=20, op1_t_s=10, & |
---|
1710 | !! op2_ti_yy= 0, op2_ti_mm= 0, op2_ti_dd=0, op2_ti_h=3, op2_ti_m=10, op2_ti_s=10, & |
---|
1711 | !! res_t_yy=2002, res_t_mm=12, res_t_dd=3, res_t_h=4, res_t_m=30, res_t_s=20, & |
---|
1712 | !! testname='AddTT1' ) |
---|
1713 | ! |
---|
1714 | ! ! Multiplication tests |
---|
1715 | ! ! ESMF_TimeInterval = ESMF_TimeInterval * INTEGER |
---|
1716 | ! CALL test_arithmetic( multiply_op=.TRUE., & |
---|
1717 | ! op1_ti_dd=3, op1_ti_h=12, op1_ti_m=18, op1_ti_s=33, & |
---|
1718 | ! op2_int=2, & |
---|
1719 | ! res_ti_dd=6, res_ti_h=24, res_ti_m=37, res_ti_s=06, & |
---|
1720 | ! testname='MultiplyTI_TI_INT1' ) |
---|
1721 | ! CALL test_arithmetic( multiply_op=.TRUE., & |
---|
1722 | ! op1_ti_dd=350, op1_ti_h=23, op1_ti_m=50, op1_ti_s=50, & |
---|
1723 | ! op2_int=2, & |
---|
1724 | ! res_ti_dd=701, res_ti_h=23, res_ti_m=41, res_ti_s=40,& |
---|
1725 | ! testname='MultiplyTI_TI_INT2' ) |
---|
1726 | ! CALL test_arithmetic( multiply_op=.TRUE., & |
---|
1727 | ! op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04, & |
---|
1728 | ! op2_int=8, & |
---|
1729 | ! res_ti_s=14, & |
---|
1730 | ! testname='MultiplyTI_TI_INT3' ) |
---|
1731 | ! |
---|
1732 | ! ! Division tests |
---|
1733 | ! ! ESMF_TimeInterval = ESMF_TimeInterval / INTEGER |
---|
1734 | ! CALL test_arithmetic( multiply_op=.FALSE., & |
---|
1735 | ! op1_ti_dd=3, op1_ti_h=12, op1_ti_m=18, op1_ti_s=33, & |
---|
1736 | ! op2_int=3, & |
---|
1737 | ! res_ti_dd=1, res_ti_h=04, res_ti_m=06, res_ti_s=11, & |
---|
1738 | ! testname='DivideTI_TI_INT1' ) |
---|
1739 | ! CALL test_arithmetic( multiply_op=.FALSE., & |
---|
1740 | ! op1_ti_dd=3, op1_ti_h=12, op1_ti_m=18, op1_ti_s=33, & |
---|
1741 | ! op2_int=4, & |
---|
1742 | ! res_ti_dd=0, res_ti_h=21, res_ti_m=04, res_ti_s=38, & |
---|
1743 | ! res_ti_sn=1, res_ti_sd=4, & |
---|
1744 | ! testname='DivideTI_TI_INT2' ) |
---|
1745 | ! CALL test_arithmetic( multiply_op=.FALSE., & |
---|
1746 | ! op1_ti_s=01, op1_ti_sn=03, op1_ti_sd=04, & |
---|
1747 | ! op2_int=5, & |
---|
1748 | ! res_ti_s=0, res_ti_sn=7, res_ti_sd=20, & |
---|
1749 | ! testname='DivideTI_TI_INT3' ) |
---|
1750 | ! |
---|
1751 | ! ! Test adjust_io_timestr() |
---|
1752 | !! CT = 2000-01-26_00:00:00 (current time) |
---|
1753 | !! ST = 2000-01-24_12:00:00 (start time) |
---|
1754 | !! TI = 00000_03:00:00 (time interval) |
---|
1755 | !! the resulting time string should be: |
---|
1756 | !! 2000-01-26_00:00:00 |
---|
1757 | ! CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0, & |
---|
1758 | ! CT_yy=2000, CT_mm=1, CT_dd=26, CT_h=0, CT_m=0, CT_s=0, & |
---|
1759 | ! ST_yy=2000, ST_mm=1, ST_dd=24, ST_h=12, ST_m=0, ST_s=0, & |
---|
1760 | ! res_str='2000-01-26_00:00:00', testname='adjust_io_timestr_1' ) |
---|
1761 | !! this should fail (and does) |
---|
1762 | !! CALL test_adjust_io_timestr( TI_h=3, TI_m=0, TI_s=0, & |
---|
1763 | !! CT_yy=2000, CT_mm=1, CT_dd=26, CT_h=0, CT_m=0, CT_s=0, & |
---|
1764 | !! ST_yy=2000, ST_mm=1, ST_dd=24, ST_h=12, ST_m=0, ST_s=0, & |
---|
1765 | !! res_str='2000-01-26_00:00:01', testname='adjust_io_timestr_FAIL1' ) |
---|
1766 | ! |
---|
1767 | !$$$here... modify these to add self-test PASS/FAIL output |
---|
1768 | CALL test_clock_advance( & |
---|
1769 | start_yy=2024, start_mm=01, start_dd=99, start_h=3, start_m=0, start_s=0, & |
---|
1770 | stop_yy=2024, stop_mm=02, stop_dd=02, stop_h=8, stop_m=0, stop_s=0, & |
---|
1771 | timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=100, & |
---|
1772 | testname="SimpleClockAdvance" ) |
---|
1773 | |
---|
1774 | PRINT *,'END CLOCK ADVANCE' |
---|
1775 | |
---|
1776 | CALL test_clock_advance( & |
---|
1777 | start_yy=2024, start_mm=07, start_dd=74, start_h=23, start_m=00, start_s=0, & |
---|
1778 | stop_yy=2025, stop_mm=01, stop_dd=07, stop_h=9, stop_m=0, stop_s=0, & |
---|
1779 | timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=1850, & |
---|
1780 | testname="StdYearClockAdvance", increment_S=10 ) |
---|
1781 | ! |
---|
1782 | ! CALL test_clock_advance( & |
---|
1783 | ! start_yy=2004, start_mm=12, start_dd=29, start_h=9, start_m=0, start_s=0, & |
---|
1784 | ! stop_yy=2005, stop_mm=1, stop_dd=2, stop_h=9, stop_m=0, stop_s=0, & |
---|
1785 | ! timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=3600, & |
---|
1786 | ! testname="LeapYearClockAdvance", increment_S=10 ) |
---|
1787 | ! |
---|
1788 | ! ! NRCM domain 3 case: 120 seconds / 9 |
---|
1789 | ! ! 18 timesteps through end of leap year |
---|
1790 | ! CALL test_clock_advance( & |
---|
1791 | ! start_yy=2004, start_mm=12, start_dd=31, start_h=23, start_m=58, start_s=0,& |
---|
1792 | ! stop_yy=2005, stop_mm=1, stop_dd=1, stop_h=0, stop_m=2, stop_s=0, & |
---|
1793 | ! timestep_d=0, timestep_h=0, timestep_m=0, timestep_s=13, & |
---|
1794 | ! timestep_sn=1, timestep_sd=3, & |
---|
1795 | ! testname="LeapYearFractionClockAdvance", & |
---|
1796 | ! increment_S=1, increment_Sn=1, increment_Sd=3 ) |
---|
1797 | ! |
---|
1798 | CALL WRFU_Finalize( rc=rc ) |
---|
1799 | CALL test_check_error( WRFU_SUCCESS, rc, & |
---|
1800 | 'WRFU_Finalize() ', & |
---|
1801 | __FILE__ , & |
---|
1802 | __LINE__ ) |
---|
1803 | |
---|
1804 | PRINT *,'END TEST SUITE' |
---|
1805 | |
---|
1806 | END PROGRAM time_manager_test |
---|
1807 | |
---|