| 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 | |
|---|