Changeset 4797 for palm/trunk/SOURCE/palm_date_time_mod.f90
- Timestamp:
- Nov 26, 2020 4:02:39 PM (3 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/palm_date_time_mod.f90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/palm_date_time_mod.f90
r4680 r4797 24 24 ! ----------------- 25 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4680 2020-09-16 10:20:34Z gronemeier 26 29 ! Add option to fix date and time; renamed set_reference_date_time to init_date_time 27 30 ! … … 31 34 ! 4227 2019-09-10 18:04:34Z gronemeier 32 35 ! Complete rework of module date_and_time_mod: 33 ! - renamed module to prevent confusion with 34 ! FORTRAN Standard routine date_and_time 36 ! - renamed module to prevent confusion with FORTRAN Standard routine date_and_time 35 37 ! - introduce date_time_type 36 38 ! - add set_reference_date_time … … 46 48 ! Description: 47 49 ! ------------ 48 !> This routine calculates all needed information on date and time used by 49 !> other modules 50 !> This routine calculates all needed information on date and time used by other modules 50 51 !> 51 52 !> @todo Consider leap seconds … … 74 75 INTEGER(iwp), PARAMETER :: southward_equinox = 264_iwp !< Sep 21 (leap year: Sep 20) 75 76 77 CHARACTER(LEN=3), DIMENSION(days_per_week), PARAMETER :: & 78 weekdays = (/"Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"/) !< names of weekdays 79 80 INTEGER, DIMENSION(months_per_year), PARAMETER :: & 81 days_per_month_noleapyear = (/31,28,31,30,31,30,31,31,30,31,30,31/) !< days for each month (no leap year) 82 83 INTEGER, DIMENSION(months_per_year), PARAMETER :: & 84 days_per_month_leapyear = (/31,29,31,30,31,30,31,31,30,31,30,31/) !< days for each month (leap year) 85 86 INTEGER, DIMENSION(121), PARAMETER :: leap_years = & !< list of leap years 87 (/ 1804_iwp, 1808_iwp, 1812_iwp, 1816_iwp, 1820_iwp, 1824_iwp, 1828_iwp, 1832_iwp, & 88 1836_iwp, 1840_iwp, 1844_iwp, 1848_iwp, 1852_iwp, 1856_iwp, 1860_iwp, 1864_iwp, & 89 1868_iwp, 1872_iwp, 1876_iwp, 1880_iwp, 1884_iwp, 1888_iwp, 1892_iwp, 1896_iwp, & 90 1904_iwp, 1908_iwp, 1912_iwp, 1916_iwp, 1920_iwp, 1924_iwp, 1928_iwp, 1932_iwp, & 91 1936_iwp, 1940_iwp, 1944_iwp, 1948_iwp, 1952_iwp, 1956_iwp, 1960_iwp, 1964_iwp, & 92 1968_iwp, 1972_iwp, 1976_iwp, 1980_iwp, 1984_iwp, 1988_iwp, 1992_iwp, 1996_iwp, & 93 2000_iwp, 2004_iwp, 2008_iwp, 2012_iwp, 2016_iwp, 2020_iwp, 2024_iwp, 2028_iwp, & 94 2032_iwp, 2036_iwp, 2040_iwp, 2044_iwp, 2048_iwp, 2052_iwp, 2056_iwp, 2060_iwp, & 95 2064_iwp, 2068_iwp, 2072_iwp, 2076_iwp, 2080_iwp, 2084_iwp, 2088_iwp, 2092_iwp, & 96 2096_iwp, 2104_iwp, 2108_iwp, 2112_iwp, 2116_iwp, 2120_iwp, 2124_iwp, 2128_iwp, & 97 2132_iwp, 2136_iwp, 2140_iwp, 2144_iwp, 2148_iwp, 2152_iwp, 2156_iwp, 2160_iwp, & 98 2164_iwp, 2168_iwp, 2172_iwp, 2176_iwp, 2180_iwp, 2184_iwp, 2188_iwp, 2192_iwp, & 99 2196_iwp, 2204_iwp, 2208_iwp, 2212_iwp, 2216_iwp, 2220_iwp, 2224_iwp, 2228_iwp, & 100 2232_iwp, 2236_iwp, 2240_iwp, 2244_iwp, 2248_iwp, 2252_iwp, 2256_iwp, 2260_iwp, & 101 2264_iwp, 2268_iwp, 2272_iwp, 2276_iwp, 2280_iwp, 2284_iwp, 2288_iwp, 2292_iwp, & 102 2296_iwp /) 103 76 104 REAL(wp), PARAMETER :: seconds_per_minute = 60.0_wp !< seconds in a minute 77 105 REAL(wp), PARAMETER :: seconds_per_hour = seconds_per_minute * minutes_per_hour !< seconds in an hour 78 106 REAL(wp), PARAMETER :: seconds_per_day = seconds_per_hour * hours_per_day !< seconds in a day 79 80 CHARACTER(LEN=3), DIMENSION(days_per_week), PARAMETER :: &81 weekdays = (/"Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"/) !< names of weekdays82 83 INTEGER, DIMENSION(months_per_year), PARAMETER :: &84 days_per_month_noleapyear = (/31,28,31,30,31,30,31,31,30,31,30,31/) !< days for each month (no leap year)85 86 INTEGER, DIMENSION(months_per_year), PARAMETER :: &87 days_per_month_leapyear = (/31,29,31,30,31,30,31,31,30,31,30,31/) !< days for each month (leap year)88 89 INTEGER, DIMENSION(121), PARAMETER :: leap_years = & !< list of leap years90 (/1804_iwp, 1808_iwp, 1812_iwp, 1816_iwp, 1820_iwp, 1824_iwp, 1828_iwp, 1832_iwp, &91 1836_iwp, 1840_iwp, 1844_iwp, 1848_iwp, 1852_iwp, 1856_iwp, 1860_iwp, 1864_iwp, &92 1868_iwp, 1872_iwp, 1876_iwp, 1880_iwp, 1884_iwp, 1888_iwp, 1892_iwp, 1896_iwp, &93 1904_iwp, 1908_iwp, 1912_iwp, 1916_iwp, 1920_iwp, 1924_iwp, 1928_iwp, 1932_iwp, &94 1936_iwp, 1940_iwp, 1944_iwp, 1948_iwp, 1952_iwp, 1956_iwp, 1960_iwp, 1964_iwp, &95 1968_iwp, 1972_iwp, 1976_iwp, 1980_iwp, 1984_iwp, 1988_iwp, 1992_iwp, 1996_iwp, &96 2000_iwp, 2004_iwp, 2008_iwp, 2012_iwp, 2016_iwp, 2020_iwp, 2024_iwp, 2028_iwp, &97 2032_iwp, 2036_iwp, 2040_iwp, 2044_iwp, 2048_iwp, 2052_iwp, 2056_iwp, 2060_iwp, &98 2064_iwp, 2068_iwp, 2072_iwp, 2076_iwp, 2080_iwp, 2084_iwp, 2088_iwp, 2092_iwp, &99 2096_iwp, 2104_iwp, 2108_iwp, 2112_iwp, 2116_iwp, 2120_iwp, 2124_iwp, 2128_iwp, &100 2132_iwp, 2136_iwp, 2140_iwp, 2144_iwp, 2148_iwp, 2152_iwp, 2156_iwp, 2160_iwp, &101 2164_iwp, 2168_iwp, 2172_iwp, 2176_iwp, 2180_iwp, 2184_iwp, 2188_iwp, 2192_iwp, &102 2196_iwp, 2204_iwp, 2208_iwp, 2212_iwp, 2216_iwp, 2220_iwp, 2224_iwp, 2228_iwp, &103 2232_iwp, 2236_iwp, 2240_iwp, 2244_iwp, 2248_iwp, 2252_iwp, 2256_iwp, 2260_iwp, &104 2264_iwp, 2268_iwp, 2272_iwp, 2276_iwp, 2280_iwp, 2284_iwp, 2288_iwp, 2292_iwp, &105 2296_iwp /)106 107 107 108 ! … … 146 147 ! 147 148 !-- Public Interfaces 148 PUBLIC &149 get_date_time, &149 PUBLIC & 150 get_date_time, & 150 151 init_date_time 151 152 ! 152 153 !-- Public variables 153 PUBLIC &154 date_time_str_len, &155 days_per_week, &156 hours_per_day, &157 minutes_per_hour, &158 months_per_year, &159 northward_equinox, &160 seconds_per_minute, &161 seconds_per_hour, &162 seconds_per_day, &163 southward_equinox, &154 PUBLIC & 155 date_time_str_len, & 156 days_per_week, & 157 hours_per_day, & 158 minutes_per_hour, & 159 months_per_year, & 160 northward_equinox, & 161 seconds_per_minute, & 162 seconds_per_hour, & 163 seconds_per_day, & 164 southward_equinox, & 164 165 weekdays 165 166 … … 180 181 LOGICAL, INTENT(IN), OPTIONAL :: use_fixed_date !< flag to fix date 181 182 LOGICAL, INTENT(IN), OPTIONAL :: use_fixed_time !< flag to fix time 183 182 184 ! 183 185 !-- Check if date and time are already set … … 185 187 !> @note This error should never be observed by a user. 186 188 !> It can only appear if the code was modified. 187 WRITE( message_string, * ) 'Multiple calls to init_date_time detected.&' // &189 WRITE( message_string, * ) 'Multiple calls to init_date_time detected.&' // & 188 190 'This routine must not be called more than once.' 189 191 CALL message( 'init_date_time', 'PA0680', 2, 2, 0, 6, 0 ) … … 212 214 !> via 'reference_date_time_str' or previously set by calling routine 'init_date_time'. 213 215 !--------------------------------------------------------------------------------------------------! 214 SUBROUTINE get_date_time( time_since_reference, reference_date_time_str, & 215 year, month, day, hour, minute, second, zone, & 216 second_of_day, second_of_year, & 217 day_of_year, day_of_week, weekday, date_time_str, & 218 days_per_month, days_per_year ) 216 SUBROUTINE get_date_time( time_since_reference, reference_date_time_str, year, month, day, hour, & 217 minute, second, zone, second_of_day, second_of_year, day_of_year, & 218 day_of_week, weekday, date_time_str, days_per_month, days_per_year ) 219 219 220 220 CHARACTER(LEN=date_time_str_len), INTENT(OUT), OPTIONAL :: date_time_str !< date-time as string … … 223 223 CHARACTER(LEN=3), INTENT(OUT), OPTIONAL :: weekday !< weekday 224 224 225 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day !< day of month 226 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_week !< number of weekday 227 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_year !< day of the year 228 INTEGER(iwp), INTENT(OUT), OPTIONAL :: hour !< hour of day 229 INTEGER(iwp), INTENT(OUT), OPTIONAL :: minute !< minute of hour 230 INTEGER(iwp), INTENT(OUT), OPTIONAL :: month !< month of year 231 INTEGER(iwp), INTENT(OUT), OPTIONAL :: year !< year 232 INTEGER(iwp), INTENT(OUT), OPTIONAL :: zone !< time zone 233 INTEGER(iwp), INTENT(OUT), OPTIONAL :: days_per_year !< days per year 225 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day !< day of month 226 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_week !< number of weekday 227 INTEGER(iwp), INTENT(OUT), OPTIONAL :: day_of_year !< day of the year 228 INTEGER(iwp), INTENT(OUT), OPTIONAL :: days_per_year !< days per year 229 INTEGER(iwp), INTENT(OUT), OPTIONAL :: hour !< hour of day 230 INTEGER(iwp), INTENT(OUT), OPTIONAL :: minute !< minute of hour 231 INTEGER(iwp), INTENT(OUT), OPTIONAL :: month !< month of year 232 INTEGER(iwp), INTENT(OUT), OPTIONAL :: year !< year 233 INTEGER(iwp), INTENT(OUT), OPTIONAL :: zone !< time zone 234 234 235 INTEGER(iwp), DIMENSION(months_per_year), INTENT(OUT), OPTIONAL :: days_per_month !< days per year 235 236 … … 247 248 !> @note This error should never be observed by a user. 248 249 !> It can only appear if the code was modified. 249 WRITE( message_string, * ) 'No reference date-time defined. '// &250 'Returning date-time information is not possible. ' // &251 'Either specify reference_date_time_str ' // &250 WRITE( message_string, * ) 'No reference date-time defined. '// & 251 'Returning date-time information is not possible. ' // & 252 'Either specify reference_date_time_str ' // & 252 253 'or set a reference via init_date_time.' 253 254 CALL message( 'get_date_time', 'PA0677', 2, 2, 0, 6, 0 ) … … 273 274 !-- If date shall be fixed, revert it to the reference date if changed 274 275 IF ( date_is_fixed ) THEN 275 IF ( date_time%year /= internal_reference_date_time%year .OR. &276 get_day_of_year( date_time ) /= get_day_of_year( internal_reference_date_time ) ) &276 IF ( date_time%year /= internal_reference_date_time%year .OR. & 277 get_day_of_year( date_time ) /= get_day_of_year( internal_reference_date_time ) ) & 277 278 THEN 278 279 279 date_time%year = internal_reference_date_time%year 280 date_time%month = internal_reference_date_time%month 281 date_time%day = internal_reference_date_time%day 282 283 date_time = update_leapyear_setting( date_time ) 284 280 date_time%year = internal_reference_date_time%year 281 date_time%month = internal_reference_date_time%month 282 date_time%day = internal_reference_date_time%day 283 date_time = update_leapyear_setting( date_time ) 285 284 date_time%second_of_year = get_second_of_year( date_time ) 286 285 … … 311 310 plus_minus = '+' 312 311 ENDIF 313 WRITE( UNIT = date_time_str, &314 FMT = '(I4,"-",I2.2,"-",I2.2,1X,I2.2,":",I2.2,":",I2.2,1X,A1,I2.2)' ) &315 date_time%year, date_time%month, date_time%day, &316 date_time%hour, date_time%minute, INT( date_time%second ), &312 WRITE( UNIT = date_time_str, & 313 FMT = '(I4,"-",I2.2,"-",I2.2,1X,I2.2,":",I2.2,":",I2.2,1X,A1,I2.2)' ) & 314 date_time%year, date_time%month, date_time%day, & 315 date_time%hour, date_time%minute, INT( date_time%second ), & 317 316 plus_minus, ABS( date_time%zone ) 318 317 ENDIF … … 326 325 !> Convert a date-time string into a date_time object. 327 326 !--------------------------------------------------------------------------------------------------! 328 FUNCTION convert_string_to_date_time( date_time_str ) RESULT( date_time )327 FUNCTION convert_string_to_date_time( date_time_str ) RESULT( date_time ) 329 328 330 329 CHARACTER(LEN=date_time_str_len), INTENT(IN) :: date_time_str !< date-time as string … … 337 336 !-- Decompose string to date-time information 338 337 READ( UNIT = date_time_str( 1: 4), IOSTAT = read_status, FMT = '(I4)' ) date_time%year 339 IF ( read_status == 0 ) &338 IF ( read_status == 0 ) THEN 340 339 READ( UNIT = date_time_str( 6: 7), IOSTAT = read_status, FMT = '(I2)' ) date_time%month 341 IF ( read_status == 0 ) & 340 ENDIF 341 IF ( read_status == 0 ) THEN 342 342 READ( UNIT = date_time_str( 9:10), IOSTAT = read_status, FMT = '(I2)' ) date_time%day 343 IF ( read_status == 0 ) & 343 ENDIF 344 IF ( read_status == 0 ) THEN 344 345 READ( UNIT = date_time_str(12:13), IOSTAT = read_status, FMT = '(I2)' ) date_time%hour 345 IF ( read_status == 0 ) & 346 ENDIF 347 IF ( read_status == 0 ) THEN 346 348 READ( UNIT = date_time_str(15:16), IOSTAT = read_status, FMT = '(I2)' ) date_time%minute 347 IF ( read_status == 0 ) & 349 ENDIF 350 IF ( read_status == 0 ) THEN 348 351 READ( UNIT = date_time_str(18:19), IOSTAT = read_status, FMT = '(F2.0)' ) date_time%second 349 IF ( read_status == 0 ) & 352 ENDIF 353 IF ( read_status == 0 ) THEN 350 354 READ( UNIT = date_time_str(21:23), IOSTAT = read_status, FMT = '(I3)' ) date_time%zone 355 ENDIF 351 356 352 357 IF ( read_status /= 0 ) THEN 353 WRITE( message_string, * ) 'Error while converting date-time string. ' // &354 'Please check format of date-time string: "' // &355 TRIM( date_time_str ) // '". ' // &358 WRITE( message_string, * ) 'Error while converting date-time string. ' // & 359 'Please check format of date-time string: "' // & 360 TRIM( date_time_str ) // '". ' // & 356 361 'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".' 357 362 CALL message( 'convert_string_to_date_time', 'PA0678', 2, 2, 0, 6, 0 ) … … 367 372 ! 368 373 !-- Shift time to UTC and set zone to UTC 369 date_time = add_date_time( REAL( -1 * date_time%zone, KIND = wp ) & 370 * seconds_per_hour, & 374 date_time = add_date_time( REAL( -1 * date_time%zone, KIND = wp ) * seconds_per_hour, & 371 375 date_time ) 372 376 date_time%zone = 0_iwp … … 401 405 date_time%second_of_year = date_time%second_of_year + inc_seconds 402 406 ! 403 !-- Check if year changes 407 !-- Check if year changes. 404 408 !-- First, if year is reduced 405 409 DO WHILE ( date_time%second_of_year < 0.0_wp ) 406 date_time%year = date_time%year - 1_iwp407 date_time = update_leapyear_setting( date_time )408 seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp )410 date_time%year = date_time%year - 1_iwp 411 date_time = update_leapyear_setting( date_time ) 412 seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp ) 409 413 date_time%second_of_year = date_time%second_of_year + seconds_per_year 410 414 ENDDO … … 412 416 !-- Now, if year is increased 413 417 DO WHILE ( date_time%second_of_year > seconds_per_year ) 414 date_time%year = date_time%year + 1_iwp415 date_time = update_leapyear_setting( date_time )418 date_time%year = date_time%year + 1_iwp 419 date_time = update_leapyear_setting( date_time ) 416 420 date_time%second_of_year = date_time%second_of_year - seconds_per_year 417 seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp )421 seconds_per_year = REAL( date_time%days_per_year * seconds_per_day, KIND = wp ) 418 422 ENDDO 419 423 ! 420 424 !-- Based on updated year and second_of_year, update month, day, hour, minute, second 421 425 DO i = 1, months_per_year 422 IF ( date_time%second_of_year < SUM( date_time%days_per_month(1:i) ) * seconds_per_day ) &426 IF ( date_time%second_of_year < SUM( date_time%days_per_month(1:i) ) * seconds_per_day ) & 423 427 THEN 424 428 date_time%month = i 425 seconds_left = date_time%second_of_year &426 - REAL( SUM( date_time%days_per_month(1:i-1) ), KIND=wp )&427 * seconds_per_day429 seconds_left = date_time%second_of_year & 430 - REAL( SUM( date_time%days_per_month(1:i-1) ), KIND=wp ) & 431 * seconds_per_day 428 432 date_time%day = INT( seconds_left / seconds_per_day, KIND = iwp ) + 1_iwp 429 seconds_left = seconds_left &430 - REAL( date_time%day - 1_iwp, KIND = wp ) * seconds_per_day433 seconds_left = seconds_left & 434 - REAL( date_time%day - 1_iwp, KIND = wp ) * seconds_per_day 431 435 date_time%hour = INT( seconds_left / seconds_per_hour, KIND = iwp ) 432 436 seconds_left = seconds_left - REAL( date_time%hour, KIND = wp ) * seconds_per_hour … … 445 449 !> Return day of year of given date. 446 450 !--------------------------------------------------------------------------------------------------! 447 FUNCTION get_day_of_year( date_time ) RESULT( day_of_year )451 FUNCTION get_day_of_year( date_time ) RESULT( day_of_year ) 448 452 449 453 INTEGER(iwp) :: day_of_year !< day of the year … … 466 470 !> Return second of day of given time. 467 471 !--------------------------------------------------------------------------------------------------! 468 FUNCTION get_second_of_day( date_time ) RESULT( second_of_day )472 FUNCTION get_second_of_day( date_time ) RESULT( second_of_day ) 469 473 470 474 REAL(wp) :: second_of_day !< second of the day … … 473 477 474 478 475 second_of_day = date_time%second &476 + REAL( ( date_time%hour * minutes_per_hour ) + date_time%minute, KIND = wp ) &477 * seconds_per_minute479 second_of_day = date_time%second & 480 + REAL( ( date_time%hour * minutes_per_hour ) + date_time%minute, KIND = wp ) & 481 * seconds_per_minute 478 482 479 483 END FUNCTION get_second_of_day … … 485 489 !> Return second of year of given date-time. 486 490 !--------------------------------------------------------------------------------------------------! 487 FUNCTION get_second_of_year( date_time ) RESULT( second_of_year )491 FUNCTION get_second_of_year( date_time ) RESULT( second_of_year ) 488 492 489 493 REAL(wp) :: second_of_year !< second of the year … … 492 496 493 497 494 second_of_year = get_second_of_day( date_time ) &495 + REAL( get_day_of_year( date_time ) - 1_iwp, KIND = wp ) * seconds_per_day498 second_of_year = get_second_of_day( date_time ) & 499 + REAL( get_day_of_year( date_time ) - 1_iwp, KIND = wp ) * seconds_per_day 496 500 497 501 END FUNCTION get_second_of_year … … 503 507 !> Return index of the day of the week of the given date-time. 504 508 !--------------------------------------------------------------------------------------------------! 505 FUNCTION get_day_of_week( date_time_in ) RESULT( day_of_week ) 506 507 INTEGER(iwp) :: date_time_internal_reference_day_of_week !< day of week of reference date 509 FUNCTION get_day_of_week( date_time_in ) RESULT( day_of_week ) 510 508 511 INTEGER(iwp) :: day_difference !< day between given date and reference 509 512 INTEGER(iwp) :: day_of_week !< day of the week 513 INTEGER(iwp) :: date_time_internal_reference_day_of_week !< day of week of reference date 510 514 511 515 TYPE(date_time_type), INTENT(IN) :: date_time_in !< date of which to get the weekday … … 548 552 ENDIF 549 553 ! 550 !-- Remove full weeks of day_difference and shift day_of_week of reference by 551 !-- remaining days 554 !-- Remove full weeks of day_difference and shift day_of_week of reference by remaining days. 552 555 day_of_week = date_time_internal_reference_day_of_week + MOD( day_difference, days_per_week ) 553 556 … … 570 573 !> Check if given year is a leap year and update days per month accordingly. 571 574 !--------------------------------------------------------------------------------------------------! 572 FUNCTION update_leapyear_setting( date_time_in ) RESULT( date_time_out )575 FUNCTION update_leapyear_setting( date_time_in ) RESULT( date_time_out ) 573 576 574 577 TYPE(date_time_type), INTENT(IN) :: date_time_in !< input date-time … … 593 596 ! ------------ 594 597 !> Check if given date and time are valid. Returns 0 if all checks are passed. 595 !> @todo Revise error message. ATM, gives only last errorneous value even if 596 !> multiple values violatethe bounds.597 !--------------------------------------------------------------------------------------------------! 598 FUNCTION check_date( date_time, date_time_str ) RESULT( error_code )598 !> @todo Revise error message. ATM, gives only last errorneous value even if multiple values violate 599 !> the bounds. 600 !--------------------------------------------------------------------------------------------------! 601 FUNCTION check_date( date_time, date_time_str ) RESULT( error_code ) 599 602 600 603 … … 612 615 ! 613 616 !-- Check date 614 IF ( date_time%month < 1_iwp .OR. & 615 date_time%month > months_per_year ) THEN 617 IF ( date_time%month < 1_iwp .OR. date_time%month > months_per_year ) THEN 616 618 error_code = 2 617 619 ELSE 618 IF ( date_time%day < 1_iwp .OR. &620 IF ( date_time%day < 1_iwp .OR. & 619 621 date_time%day > date_time%days_per_month(date_time%month) ) THEN 620 622 error_code = 3 … … 623 625 ! 624 626 !-- Check time 625 IF ( date_time%hour < 0_iwp .OR. & 626 date_time%hour > hours_per_day ) THEN 627 IF ( date_time%hour < 0_iwp .OR. date_time%hour > hours_per_day ) THEN 627 628 error_code = 4 628 629 ELSE 629 IF ( date_time%minute < 0_iwp .OR. & 630 date_time%minute > minutes_per_hour ) THEN 630 IF ( date_time%minute < 0_iwp .OR. date_time%minute > minutes_per_hour ) THEN 631 631 error_code = 5 632 632 ELSE 633 IF ( date_time%second < 0.0_wp .OR. & 634 date_time%second >= seconds_per_minute ) THEN 633 IF ( date_time%second < 0.0_wp .OR. date_time%second >= seconds_per_minute ) THEN 635 634 error_code = 6 636 635 ENDIF … … 638 637 ENDIF 639 638 ! 640 !-- Check time zone 639 !-- Check time zone. 641 640 !-- Bounds defined by maximum and minimum time zone present on earth 642 IF ( date_time%zone < -12_iwp .OR. & 643 date_time%zone > 14_iwp ) THEN 641 IF ( date_time%zone < -12_iwp .OR. date_time%zone > 14_iwp ) THEN 644 642 error_code = 7 645 643 ENDIF … … 647 645 !-- Raise error if any check is marked invalid 648 646 IF ( error_code /= 0 ) THEN 649 WRITE( message_string, * ) 'Date-time values out of bounds: "' // &650 TRIM( error_str_list(error_code) ) // &651 '" is out of bounds. Please check date-time string: "' // &652 TRIM( date_time_str ) // '". ' // &647 WRITE( message_string, * ) 'Date-time values out of bounds: "' // & 648 TRIM( error_str_list(error_code) ) // & 649 '" is out of bounds. Please check date-time string: "' // & 650 TRIM( date_time_str ) // '". ' // & 653 651 'Format must be "YYYY-MM-DD hh:mm:ss ZZZ".' 654 652 CALL message( 'check_date', 'PA0679', 2, 2, 0, 6, 0 )
Note: See TracChangeset
for help on using the changeset viewer.
