From 2b5853db65c334ec40ae23b224338e6051aaa946 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Fri, 19 May 2023 17:16:22 -0400 Subject: [PATCH 01/32] Updated procedures for adjusted requirements --- base/MAPL_NetCDF.F90 | 393 +++++++++++++++++++++++++++------ base/tests/test_MAPL_NetCDF.pf | 207 ++++++++++++----- 2 files changed, 480 insertions(+), 120 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 773a297cd2b8..7e7290a14663 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -1,4 +1,9 @@ !wdb todo +! todo Switch integer to integer(kind=ESMF_KIND_I8) where appropriate. +!Do REAL(8) days need to be included? +!Do INTEGER or INTEGER(8) days need to be included? +!Is d_r8 Julian day or Gregorian day? + !subroutine to convert !From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] !To: !ESMF_TIME: with gregorian calendar @@ -20,10 +25,9 @@ module MAPL_NetCDF public :: convert_NetCDF_DateTime_to_ESMF public :: convert_ESMF_to_NetCDF_DateTime - - private + public :: convert_NetCDF_DateTime_to_ESMF_Time public :: make_ESMF_TimeInterval - public :: make_NetCDF_DateTime_int_time + public :: make_NetCDF_DateTime_duration public :: make_NetCDF_DateTime_units_string public :: convert_ESMF_Time_to_NetCDF_DateTimeString public :: convert_to_integer @@ -33,38 +37,59 @@ module MAPL_NetCDF public :: get_shift_sign public :: split public :: split_all - public :: lr_trim + public :: get_NetCDF_duration_from_ESMF_Time + + interface convert_NetCDF_DateTime_to_ESMF_Time + module procedure :: convert_NetCDF_DateTime_to_ESMF_Time_integer + end interface convert_NetCDF_DateTime_to_ESMF_Time + + interface make_ESMF_TimeInterval + module procedure :: make_ESMF_TimeInterval_integer + module procedure :: make_ESMF_TimeInterval_real + end interface make_ESMF_TimeInterval + + interface make_NetCDF_DateTime_duration + module procedure :: make_NetCDF_DateTime_duration_integer + module procedure :: make_NetCDF_DateTime_duration_real + end interface make_NetCDF_DateTime_duration + + interface get_NetCDF_duration_from_ESMF_Time + module procedure :: get_NetCDF_duration_from_ESMF_Time_integer + module procedure :: get_NetCDF_duration_from_ESMF_Time_real + end interface get_NetCDF_duration_from_ESMF_Time + + private character, parameter :: PART_DELIM = ' ' - character, parameter :: ISO_DELIM = 'T' + character, parameter :: ISO_DELIM = 'T' character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' - character(len=*), parameter :: NETCDF_DATETIME_FORMAT = NETCDF_DATE // PART_DELIM // NETCDF_TIME + character(len=*), parameter :: NETCDF_DATETIME = NETCDF_DATE // PART_DELIM // NETCDF_TIME integer, parameter :: LEN_DATE = len(NETCDF_DATE) integer, parameter :: LEN_TIME = len(NETCDF_TIME) - integer, parameter :: LEN_NETCDF_DATETIME = len(NETCDF_DATETIME_FORMAT) + integer, parameter :: LEN_DATETIME = len(NETCDF_DATETIME) + integer, parameter :: NUM_PARTS_UNITS_STRING = 4 character(len=*), parameter :: TIME_UNITS(7) = & [ 'years ', 'months ', 'days ', & 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] character, parameter :: SPACE = ' ' type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN - integer, parameter :: MAX_WIDTH = 10 contains ! Convert NetCDF_DateTime {int_time, units_string} to - ! ESMF time variables {interval, time0, time1} and time unit {tunit} - ! time0 is the start time, and time1 is time0 + interval + ! ESMF time variables {interval, start_time, time} and time unit {tunit} + ! start_time is the start time, and time is start_time + interval subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & - interval, time0, unusable, time1, tunit, rc) + interval, start_time, unusable, time, tunit, rc) integer, intent(in) :: int_time character(len=*), intent(in) :: units_string type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: time0 + type(ESMF_Time), intent(inout) :: start_time class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: time1 + type(ESMF_Time), optional, intent(inout) :: time character(len=:), allocatable, optional, intent(out) :: tunit integer, optional, intent(out) :: rc character(len=:), allocatable :: tunit_ @@ -78,18 +103,18 @@ subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & _UNUSED_DUMMY(unusable) _ASSERT(int_time >= 0, 'Negative span not supported') - _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') ! get time unit, tunit - parts = split(lr_trim(units_string), PART_DELIM) + parts = split(trim(adjustl(units_string)), PART_DELIM) head = parts(1) tail = parts(2) - tunit_ = lr_trim(head) + tunit_ = trim(adjustl(head)) _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') if(present(tunit)) tunit = tunit_ ! get span - parts = split(lr_trim(tail), PART_DELIM) + parts = split(trim(adjustl(tail)), PART_DELIM) head = parts(1) tail = parts(2) @@ -97,24 +122,24 @@ subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & _ASSERT(factor /= 0, 'Unrecognized preposition') span = factor * int_time - call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) - call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(trim(adjustl(tail)), start_time, _RC) + call make_ESMF_TimeInterval(span, tunit_, start_time, interval, _RC) - ! get time1 - if(present(time1)) time1 = time0 + interval + ! get time + if(present(time)) time = start_time + interval _RETURN(_SUCCESS) end subroutine convert_NetCDF_DateTime_to_ESMF ! Convert ESMF time variables to an NetCDF datetime - subroutine convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, unusable, t1, interval, rc) + subroutine convert_ESMF_to_NetCDF_DateTime(tunit, start_time, int_time, units_string, unusable, time, interval, rc) character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 + type(ESMF_Time), intent(inout) :: start_time integer, intent(out) :: int_time character(len=:), allocatable, intent(out) :: units_string class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: t1 + type(ESMF_Time), optional, intent(inout) :: time type(ESMF_TimeInterval), optional, intent(inout) :: interval integer, optional, intent(out) :: rc type(ESMF_TimeInterval) :: interval_ @@ -124,24 +149,24 @@ subroutine convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, un if(present(interval)) then interval_ = interval - elseif(present(t1)) then - interval_ = t1 - t0 + elseif(present(time)) then + interval_ = time - start_time else _FAIL( 'Only one input argument present') end if - call make_NetCDF_DateTime_int_time(interval_, t0, tunit, int_time, _RC) - call make_NetCDF_DateTime_units_string(t0, tunit, units_string, _RC) + call make_NetCDF_DateTime_duration(interval_, start_time, tunit, int_time, _RC) + call make_NetCDF_DateTime_units_string(start_time, tunit, units_string, _RC) _RETURN(_SUCCESS) end subroutine convert_ESMF_to_NetCDF_DateTime ! Make ESMF_TimeInterval from a span of time, time unit, and start time - subroutine make_ESMF_TimeInterval(span, tunit, t0, interval, unusable, rc) + subroutine make_ESMF_TimeInterval_integer(span, tunit, start_time, interval, unusable, rc) integer, intent(in) :: span character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 + type(ESMF_Time), intent(inout) :: start_time type(ESMF_TimeInterval), intent(inout) :: interval class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -149,60 +174,61 @@ subroutine make_ESMF_TimeInterval(span, tunit, t0, interval, unusable, rc) _UNUSED_DUMMY(unusable) - select case(lr_trim(tunit)) + select case(trim(adjustl(tunit))) case('years') - call ESMF_TimeIntervalSet(interval, startTime=t0, yy=span, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) case('months') - call ESMF_TimeIntervalSet(interval, startTime=t0, mm=span, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) case('hours') - call ESMF_TimeIntervalSet(interval, startTime=t0, h=span, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, h=span, _RC) case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=t0, m=span, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, m=span, _RC) case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=span, _RC) case default _FAIL('Unrecognized unit') end select _RETURN(_SUCCESS) - end subroutine make_ESMF_TimeInterval + end subroutine make_ESMF_TimeInterval_integer ! Get time span from NetCDF datetime - subroutine make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, unusable, rc) + ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (integer) + subroutine make_NetCDF_DateTime_duration_integer(interval, start_time, units, duration, unusable, rc) type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: t0 - character(len=*), intent(in) :: tunit - integer, intent(out) :: int_time + type(ESMF_Time), intent(inout) :: start_time + character(len=*), intent(in) :: units + integer, intent(out) :: duration class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: status _UNUSED_DUMMY(unusable) - ! get int_time - select case(lr_trim(tunit)) + ! get duration + select case(trim(adjustl(units))) case('years') - call ESMF_TimeIntervalGet(interval, t0, yy=int_time, _RC) + call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) case('months') - call ESMF_TimeIntervalGet(interval, t0, mm=int_time, _RC) + call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) case('hours') - call ESMF_TimeIntervalGet(interval, t0, h=int_time, _RC) + call ESMF_TimeIntervalGet(interval, start_time, h=duration, _RC) case('minutes') - call ESMF_TimeIntervalGet(interval, t0, m=int_time, _RC) + call ESMF_TimeIntervalGet(interval, start_time, m=duration, _RC) case('seconds') - call ESMF_TimeIntervalGet(interval, t0, s=int_time, _RC) + call ESMF_TimeIntervalGet(interval, start_time, s=duration, _RC) case default _FAIL('Unrecognized unit') end select _RETURN(_SUCCESS) - end subroutine make_NetCDF_DateTime_int_time + end subroutine make_NetCDF_DateTime_duration_integer ! Make 'units' for NetCDF datetime - subroutine make_NetCDF_DateTime_units_string(t0, tunit, units_string, unusable, rc) - type(ESMF_Time), intent(inout) :: t0 + subroutine make_NetCDF_DateTime_units_string(start_time, tunit, units_string, unusable, rc) + type(ESMF_Time), intent(inout) :: start_time character(len=*), intent(in) :: tunit character(len=:), allocatable, intent(out) :: units_string class (KeywordEnforcer), optional, intent(in) :: unusable @@ -214,7 +240,7 @@ subroutine make_NetCDF_DateTime_units_string(t0, tunit, units_string, unusable, _UNUSED_DUMMY(unusable) ! make units_string - call convert_ESMF_Time_to_NetCDF_DateTimeString(t0, datetime_string, _RC) + call convert_ESMF_Time_to_NetCDF_DateTimeString(start_time, datetime_string, _RC) units_string = tunit //SPACE// preposition //SPACE// datetime_string _RETURN(_SUCCESS) @@ -237,7 +263,7 @@ subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_st character(len=2) :: h_string character(len=2) :: m_string character(len=2) :: s_string - character(len=LEN_NETCDF_DATETIME) :: tmp_string + character(len=LEN_DATETIME) :: tmp_string integer :: status, iostatus _UNUSED_DUMMY(unusable) @@ -345,13 +371,13 @@ function is_valid_netcdf_datetime_string(string) result(tval) tval = .false. - if(len(string) /= len(NETCDF_DATETIME_FORMAT)) return + if(len(string) /= len(NETCDF_DATETIME)) return do i=1, len(string) - if(scan(NETCDF_DATETIME_FORMAT(i:i), DIGITS) > 0) then + if(scan(NETCDF_DATETIME(i:i), DIGITS) > 0) then if(scan(string(i:i), DIGITS) <= 0) return else - if(string(i:i) /= NETCDF_DATETIME_FORMAT(i:i)) return + if(string(i:i) /= NETCDF_DATETIME(i:i)) return end if end do @@ -366,27 +392,19 @@ function is_time_unit(tunit) is_time_unit = .TRUE. do i = 1, size(TIME_UNITS) - if(lr_trim(tunit) == lr_trim(TIME_UNITS(i))) return + if(adjustl(tunit) == adjustl(TIME_UNITS(i))) return end do is_time_unit = .FALSE. end function is_time_unit - function lr_trim(string) - character(len=*), intent(in) :: string - character(len=:), allocatable :: lr_trim - - lr_trim = trim(adjustl(string)) - - end function lr_trim - ! Get the sign of integer represening a time span based on preposition function get_shift_sign(preposition) character(len=*), intent(in) :: preposition integer :: get_shift_sign integer, parameter :: POSITIVE = 1 get_shift_sign = 0 - if(lr_trim(preposition) == 'since') get_shift_sign = POSITIVE + if(adjustl(preposition) == 'since') get_shift_sign = POSITIVE end function get_shift_sign ! Split string at delimiter @@ -397,11 +415,16 @@ function split(string, delimiter) integer start split = ['', ''] - split(1) = string + start = index(string, delimiter) - if(start < 1) return + if(start == 0) then + split(1) = string + return + end if + split(1) = string(1:(start - 1)) split(2) = string((start+len(delimiter)):len(string)) + end function split ! Split string into all substrings based on delimiter @@ -421,4 +444,238 @@ recursive function split_all(string, delimiter) result(parts) end function split_all + subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & + units_string, time, unusable, rc) + integer, intent(in) :: duration + character(len=*), intent(in) :: units_string + class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), intent(inout) :: time + integer, optional, intent(out) :: rc + + character(len=:), allocatable :: parts(:) + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string + integer :: signed_duration, sign_factor + integer :: status + + _UNUSED_DUMMY(unusable) + + _ASSERT(duration >= 0, 'Negative duration not supported') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') + + parts = split_all(units_string, PART_DELIM) + _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') + + units = adjustl(parts(1)) + preposition = adjustl(parts(2)) + date_string = adjustl(parts(3)) + time_string = adjustl(parts(4)) + + sign_factor = get_shift_sign(preposition) + _ASSERT(sign_factor /= 0, 'Unrecognized preposition') + signed_duration = sign_factor * duration + + call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) + + time = start_time + interval + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer + + ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) + subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) + type(ESMF_Time), intent(inout) :: time + character(len=:), allocatable, intent(in) :: units_string + integer, intent(out) :: duration + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + character(len=:), allocatable :: parts(:) + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string + integer :: status + integer(ESMF_KIND_I8) :: sign_factor + + _UNUSED_DUMMY(unusable) + + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') + + parts = split_all(units_string, PART_DELIM) + _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') + + units = adjustl(parts(1)) + preposition = adjustl(parts(2)) + date_string = adjustl(parts(3)) + time_string = adjustl(parts(4)) + + call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + interval = time - start_time + + call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) + sign_factor = get_shift_sign(preposition) + _ASSERT(sign_factor /= 0, 'Unrecognized preposition') + duration = sign_factor * duration + + _RETURN(_SUCCESS) + + end subroutine get_NetCDF_duration_from_ESMF_Time_integer + + subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & + units_string, time, unusable, rc) + real(kind=ESMF_KIND_R8), intent(in) :: duration + character(len=*), intent(in) :: units_string + class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), intent(inout) :: time + integer, optional, intent(out) :: rc + + character(len=:), allocatable :: parts(:) + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string + real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor + integer :: status + + _UNUSED_DUMMY(unusable) + + _ASSERT(duration >= 0, 'Negative duration not supported') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') + + parts = split_all(units_string, PART_DELIM) + _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') + + units = adjustl(parts(1)) + preposition = adjustl(parts(2)) + date_string = adjustl(parts(3)) + time_string = adjustl(parts(4)) + + sign_factor = get_shift_sign(preposition) + _ASSERT(sign_factor /= 0, 'Unrecognized preposition') + signed_duration = sign_factor * duration + + call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) + + time = start_time + interval + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTime_to_ESMF_Time_real + + subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusable, rc) + real(kind=ESMF_KIND_R8), intent(in) :: span + character(len=*), intent(in) :: tunit + type(ESMF_Time), intent(inout) :: start_time + type(ESMF_TimeInterval), intent(inout) :: interval + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + select case(trim(adjustl(tunit))) + case('years') + call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) + case('months') + call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) + case('hours') + call ESMF_TimeIntervalSet(interval, startTime=start_time, h_r8=span, _RC) + case('minutes') + call ESMF_TimeIntervalSet(interval, startTime=start_time, m_r8=span, _RC) + case('seconds') + call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=span, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_ESMF_TimeInterval_real + + ! Get time span from NetCDF datetime + ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (real) + subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, duration, unusable, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: start_time + character(len=*), intent(in) :: units + real(kind=ESMF_KIND_R8), intent(out) :: duration + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + ! get duration + select case(trim(adjustl(units))) + case('years') + call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) + case('months') + call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) + case('hours') + call ESMF_TimeIntervalGet(interval, start_time, h_r8=duration, _RC) + case('minutes') + call ESMF_TimeIntervalGet(interval, start_time, m_r8=duration, _RC) + case('seconds') + call ESMF_TimeIntervalGet(interval, start_time, s_r8=duration, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_NetCDF_DateTime_duration_real + + subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, unusable, rc) + type(ESMF_Time), intent(inout) :: time + character(len=:), allocatable, intent(in) :: units_string + real(kind=ESMF_KIND_R8), intent(out) :: duration + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + character(len=:), allocatable :: parts(:) + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string + integer :: status + integer(ESMF_KIND_I8) :: sign_factor + + _UNUSED_DUMMY(unusable) + + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') + + parts = split_all(units_string, PART_DELIM) + _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') + + units = adjustl(parts(1)) + preposition = adjustl(parts(2)) + date_string = adjustl(parts(3)) + time_string = adjustl(parts(4)) + + call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + interval = time - start_time + + call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) + sign_factor = get_shift_sign(preposition) + _ASSERT(sign_factor /= 0, 'Unrecognized preposition') + duration = sign_factor * duration + + _RETURN(_SUCCESS) + + end subroutine get_NetCDF_duration_from_ESMF_Time_real + end module MAPL_NetCDF diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index db929d3348cc..fedc605a1edf 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -21,108 +21,137 @@ contains end subroutine set_up + function make_units_string(units, preposition, yy, mm, dd, h, m, s) result(units_string) + character(len=*), intent(in) :: units + character(len=*), intent(in) :: preposition + integer, intent(in) :: yy, mm, dd, h, m, s + character(len=32) :: units_string + + character, parameter :: D = '-' + character, parameter :: T = ':' + character(len=*), parameter :: I2 = ', I2.2' + character(len=*), parameter :: OA = '(A' // ', 1X, A, 1X' + character(len=*), parameter :: YMD = ', I4.4'// D // I2 // D // I2 + character(len=*), parameter :: HMS = ', 1X' // I2 // T // I2 // T // I2 // ')' +! character(len=*), parameter :: fmt_string = OA // YMD // HMS + integer :: status + + character(len=*), parameter :: fmt_string = '(A, 1X, A, 1X, I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' + write(units_string, fmt=fmt_string, iostat=status) trim(units), trim(preposition), yy, mm, dd, h, m, s + if(status == 0) return + + units_string = '' + + end function make_units_string + + logical function ESMF_Times_Equal(timeu, timev) + type(ESMF_Time), intent(in) :: timeu, timev + ESMF_Times_Equal = (timeu == timev) + end function ESMF_Times_Equal + @Test subroutine test_convert_NetCDF_DateTime_to_ESMF() character(len=*), parameter :: expected_tunit = 'seconds' integer, parameter :: int_time = 1800 character(len=*), parameter :: units_string = expected_tunit // ' since 2012-08-26 12:36:37' - character(len=*), parameter :: t0_iso_string = '2012-08-26T12:36:37' - character(len=*), parameter :: t1_iso_string = '2012-08-26T13:06:37' + character(len=*), parameter :: start_time_iso_string = '2012-08-26T12:36:37' + character(len=*), parameter :: time_iso_string = '2012-08-26T13:06:37' type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: expected_time0 - type(ESMF_Time) :: expected_time1 + type(ESMF_Time) :: expected_start_time + type(ESMF_Time) :: expected_time type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: time0 - type(ESMF_Time) :: time1 + type(ESMF_Time) :: start_time + type(ESMF_Time) :: time character(len=:), allocatable :: tunit integer :: rc, status - call ESMF_TimeSet(expected_time0, timeString=t0_iso_string, _RC) - call ESMF_TimeSet(expected_time1, timeString=t1_iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=expected_time0, s=int_time, _RC) + call ESMF_TimeSet(expected_start_time, timeString=start_time_iso_string, _RC) + call ESMF_TimeSet(expected_time, timeString=time_iso_string, _RC) + call ESMF_TimeIntervalSet(expected_interval, startTime=expected_start_time, s=int_time, _RC) - call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, time0, time1=time1, tunit=tunit, _RC) - @assertTrue(expected_time0 == time0, 'Mismatch for time0') - @assertTrue(expected_time1 == time1, 'Mismatch for time1') + call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, start_time, time=time, tunit=tunit, _RC) + @assertTrue(expected_start_time == start_time, 'Mismatch for start_time') + @assertTrue(expected_time == time, 'Mismatch for time') @assertTrue(expected_interval == interval, 'Mismatch for interval') end subroutine test_convert_NetCDF_DateTime_to_ESMF @Test subroutine test_convert_ESMF_to_NetCDF_DateTime() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: t0_iso_string = '2013-08-26T12:34:56' - type(ESMF_Time) :: t0 - character(len=*), parameter :: t1_iso_string = '2013-08-26T13:04:56' - type(ESMF_Time) :: t1 + character(len=*), parameter :: units = 'seconds' + character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' + type(ESMF_Time) :: start_time + character(len=*), parameter :: time_iso_string = '2013-08-26T13:04:56' + type(ESMF_Time) :: time type(ESMF_TimeInterval) :: interval - integer, parameter :: span = 1800 - character(len=*), parameter :: expected_units_string = tunit // ' since 2013-08-26 12:34:56' - integer, parameter :: expected_int_time = span - integer :: int_time + integer, parameter :: expected_duration = 1800 + character(len=*), parameter :: expected_units_string = units // ' since 2013-08-26 12:34:56' + integer :: duration character(len=:), allocatable :: units_string integer :: rc, status - call ESMF_TimeSet(t0, t0_iso_string, _RC) - call ESMF_TimeSet(t1, t1_iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) + call ESMF_TimeSet(start_time, start_time_iso_string, _RC) + call ESMF_TimeSet(time, time_iso_string, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) - call convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, t1=t1, _RC) - @assertEqual(expected_int_time, int_time, 'Using t1, expected_int_time /= int_time') - @assertEqual(expected_units_string, units_string, 'Using t1, expected_units_strin g/= units_string') + call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, time=time, _RC) + @assertEqual(expected_duration, duration, 'Using time, expected_duration /= duration') + @assertEqual(expected_units_string, units_string, 'Using time, expected_units_strin g/= units_string') - call convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, interval=interval, _RC) - @assertEqual(expected_int_time, int_time, 'Using interval, expected_int_time /= int_time') + call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, interval=interval, _RC) + @assertEqual(expected_duration, duration, 'Using interval, expected_duration /= duration') @assertEqual(expected_units_string, units_string, 'Using interval, expected_units_strin g/= units_string') end subroutine test_convert_ESMF_to_NetCDF_DateTime @Test subroutine test_make_ESMF_TimeInterval() - character(len=*), parameter :: tunit = 'seconds' + character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - integer, parameter :: span = 1800 + integer, parameter :: duration = 1800 type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: t0 + type(ESMF_Time) :: start_time type(ESMF_TimeInterval) :: interval integer :: rc, status - call ESMF_TimeSet(t0, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=t0, s=span, _RC) - call make_ESMF_TimeInterval(span, tunit, t0, interval, _RC) + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s=duration, _RC) + call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') end subroutine test_make_ESMF_TimeInterval @Test - subroutine test_make_NetCDF_DateTime_int_time() + subroutine test_make_NetCDF_DateTime_duration() character(len=*), parameter :: tunit = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: t0 + type(ESMF_Time) :: start_time integer, parameter :: expected_int_time = 1800 integer :: int_time integer :: status, rc - call ESMF_TimeSet(t0, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=t0, s=expected_int_time, _RC) + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_int_time, _RC) - call make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, _RC) + call make_NetCDF_DateTime_duration(interval, start_time, tunit, int_time, _RC) @assertEqual(expected_int_time, int_time, 'int_time does not match.') - end subroutine test_make_NetCDF_DateTime_int_time + end subroutine test_make_NetCDF_DateTime_duration @Test subroutine test_make_NetCDF_DateTime_units_string() - type(ESMF_Time) :: t0 + type(ESMF_Time) :: start_time character(len=*), parameter :: tunit = 'seconds' character(len=*), parameter :: expected = tunit // ' since 2012-08-26 08:36:37' character(len=:), allocatable :: actual - integer :: status, rc + integer :: status - call ESMF_TimeSet(t0, yy=2012, mm=08, dd=26, h=08, m=36, s=37, _RC) - call make_NetCDF_DateTime_units_string(t0, tunit, actual, _RC) + call ESMF_TimeSet(start_time, yy=2012, mm=08, dd=26, h=08, m=36, s=37, rc=status) + @assertEqual(status, 0, 'Failed to set ESMF_Time') + call make_NetCDF_DateTime_units_string(start_time, tunit, actual, rc=status) + @assertEqual(0, status, 'Failed to make units_string') @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) end subroutine test_make_NetCDF_DateTime_units_string @@ -179,13 +208,6 @@ contains end subroutine test_is_time_unit -! @Test - subroutine test_lr_trim() - @assertEqual('word', lr_trim(' word')) - @assertEqual('word', lr_trim('word ')) - @assertEqual('word', lr_trim(' word ')) - end subroutine test_lr_trim - ! @test subroutine test_get_shift_sign() character(len=:), allocatable :: preposition @@ -273,4 +295,85 @@ contains end subroutine test_convert_to_integer +! @test + subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer() + character, parameter :: D = '-' + character, parameter :: T = ':' + character(len=*), parameter :: I2 = ', I2.2' + character(len=*), parameter :: OA = '(A' // ', 1X, A, 1X' + character(len=*), parameter :: YMD = ', I4.4'// D // I2 // D // I2 + character(len=*), parameter :: HMS = ', 1X' // I2 // T // I2 // T // I2 // ')' + character(len=*), parameter :: fmt_string = OA // YMD // HMS + + integer :: duration + integer :: yy, mm, dd, h, m, s + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + character(len=32) :: units_string + type(ESMF_Time) :: time, esmf_time + integer :: status + + duration=1800 + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 59 + s = 59 + units = 'seconds' + preposition = 'since' + + units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) + @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + + call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertEqual(0, status, 'Unable to create expected ESMF_Time') + + call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) + @assertEqual(0, status, 'Conversion failed') + + @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Times''s don''t match.') + + end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer + +! @test + subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() + type(ESMF_Time) :: time + character(len=:), allocatable :: units_string + integer :: duration, expected_duration + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + integer :: yy, mm, dd, h, m, s + integer :: status + + expected_duration=1800 + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 29 + s = 59 + units = 'seconds' + preposition = 'since' + + units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) + @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + + call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) + @assertEqual(0, status, 'Failed to create time') + + call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) + @assertEqual(0, status, 'Failed to create time') + @assertEqual(expected_duration, duration, 'Expected duration does not match expected duration.') + + end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer + +! @test + subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time_integer() + end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time_integer + +! @test + subroutine test_make_ESMF_TimeInterval_integer() + end subroutine test_make_ESMF_TimeInterval_integer + end module test_MAPL_NetCDF From a96471bed43aa2c26342849163d1d45546a6c282 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 30 May 2023 18:19:24 -0400 Subject: [PATCH 02/32] Fix splitting routines --- base/MAPL_NetCDF.F90 | 407 ++++++++++++++++++++------------- base/tests/test_MAPL_NetCDF.pf | 367 +++++++++++++++++++++++------ 2 files changed, 545 insertions(+), 229 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 7e7290a14663..799c0c62b556 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -3,6 +3,7 @@ !Do REAL(8) days need to be included? !Do INTEGER or INTEGER(8) days need to be included? !Is d_r8 Julian day or Gregorian day? +!Does get_shift_sign need to be converted to real for real procedures? !subroutine to convert !From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] @@ -41,6 +42,7 @@ module MAPL_NetCDF interface convert_NetCDF_DateTime_to_ESMF_Time module procedure :: convert_NetCDF_DateTime_to_ESMF_Time_integer + module procedure :: convert_NetCDF_DateTime_to_ESMF_Time_real end interface convert_NetCDF_DateTime_to_ESMF_Time interface make_ESMF_TimeInterval @@ -58,6 +60,14 @@ module MAPL_NetCDF module procedure :: get_NetCDF_duration_from_ESMF_Time_real end interface get_NetCDF_duration_from_ESMF_Time + interface split + module procedure :: split_chars + end interface split + + interface split_all + module procedure :: split_all_recursive + module procedure :: split_all_iterative + end interface split_all private character, parameter :: PART_DELIM = ' ' @@ -294,156 +304,6 @@ subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_st end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString - ! Convert string representing an integer to the integer - subroutine convert_to_integer(string_in, int_out, rc) - character(len=*), intent(in) :: string_in - integer, intent(out) :: int_out - integer, optional, intent(out) :: rc - integer :: stat - - read(string_in, '(I16)', iostat=stat) int_out - - if(present(rc)) rc = stat - - end subroutine convert_to_integer - - ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) - character(len=*), intent(in) :: datetime_string - type(ESMF_Time), intent(inout) :: datetime - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - integer :: yy, mm, dd, h, m, s, i, j - character(len=4) :: part - - _UNUSED_DUMMY(unusable) - - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') - - i = 1 - j = i + 3 - part = datetime_string(i:j) - call convert_to_integer(part, yy, rc = status) - _ASSERT(status == 0, 'Unable to convert year string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, mm, rc = status) - _ASSERT(status == 0, 'Unable to convert month string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, dd, rc = status) - _ASSERT(status == 0, 'Unable to convert day string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, h, rc = status) - _ASSERT(status == 0, 'Unable to convert hour string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, m, rc = status) - _ASSERT(status == 0, 'Unable to convert minute string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, s, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time - - function is_valid_netcdf_datetime_string(string) result(tval) - character(len=*), parameter :: DIGITS = '0123456789' - character(len=*), intent(in) :: string - logical :: tval - integer :: i - - tval = .false. - - if(len(string) /= len(NETCDF_DATETIME)) return - - do i=1, len(string) - if(scan(NETCDF_DATETIME(i:i), DIGITS) > 0) then - if(scan(string(i:i), DIGITS) <= 0) return - else - if(string(i:i) /= NETCDF_DATETIME(i:i)) return - end if - end do - - tval = .true. - - end function is_valid_netcdf_datetime_string - - function is_time_unit(tunit) - character(len=*), intent(in) :: tunit - logical :: is_time_unit - integer :: i - - is_time_unit = .TRUE. - do i = 1, size(TIME_UNITS) - if(adjustl(tunit) == adjustl(TIME_UNITS(i))) return - end do - is_time_unit = .FALSE. - - end function is_time_unit - - ! Get the sign of integer represening a time span based on preposition - function get_shift_sign(preposition) - character(len=*), intent(in) :: preposition - integer :: get_shift_sign - integer, parameter :: POSITIVE = 1 - get_shift_sign = 0 - if(adjustl(preposition) == 'since') get_shift_sign = POSITIVE - end function get_shift_sign - - ! Split string at delimiter - function split(string, delimiter) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=len(string)) :: split(2) - integer start - - split = ['', ''] - - start = index(string, delimiter) - if(start == 0) then - split(1) = string - return - end if - - split(1) = string(1:(start - 1)) - split(2) = string((start+len(delimiter)):len(string)) - - end function split - - ! Split string into all substrings based on delimiter - recursive function split_all(string, delimiter) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=:), allocatable :: parts(:) - integer :: start - - start = index(string, delimiter) - - if(start == 0) then - parts = [string] - else - parts = [string(1:(start-1)), split_all(string((start+len(delimiter)):len(string)), delimiter)] - end if - - end function split_all - subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & units_string, time, unusable, rc) integer, intent(in) :: duration @@ -457,8 +317,9 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & type(ESMF_Time) :: start_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string + character(len=LEN_DATE) :: date_string + character(len=LEN_TIME) :: time_string + character(len=LEN_DATETIME) :: datetime_string integer :: signed_duration, sign_factor integer :: status @@ -474,12 +335,13 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & preposition = adjustl(parts(2)) date_string = adjustl(parts(3)) time_string = adjustl(parts(4)) + datetime_string = date_string // PART_DELIM // time_string sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') signed_duration = sign_factor * duration - call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) time = start_time + interval @@ -510,7 +372,7 @@ subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, durati _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(units_string, PART_DELIM) + parts = split_all(trim(units_string), PART_DELIM) _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') units = adjustl(parts(1)) @@ -587,9 +449,13 @@ subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusab select case(trim(adjustl(tunit))) case('years') - call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) + _FAIL('Real values for years are not supported.') +! call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) case('months') - call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) + _FAIL('Real values for months are not supported.') +! call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) + case('days') + _FAIL('Real values for days are not supported.') case('hours') call ESMF_TimeIntervalSet(interval, startTime=start_time, h_r8=span, _RC) case('minutes') @@ -620,9 +486,13 @@ subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, durat ! get duration select case(trim(adjustl(units))) case('years') - call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) + _FAIL('Real values for years are not supported.') +! call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) case('months') - call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) + _FAIL('Real values for months are not supported.') +! call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) + case('days') + _FAIL('Real values for days are not supported.') case('hours') call ESMF_TimeIntervalGet(interval, start_time, h_r8=duration, _RC) case('minutes') @@ -678,4 +548,225 @@ subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, end subroutine get_NetCDF_duration_from_ESMF_Time_real + ! Convert NetCDF datetime to ESMF_Time + subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) + character(len=*), intent(in) :: datetime_string + type(ESMF_Time), intent(inout) :: datetime + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + integer :: yy, mm, dd, h, m, s, i, j + character(len=4) :: part + + _UNUSED_DUMMY(unusable) + + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') + + i = 1 + j = i + 3 + part = datetime_string(i:j) + call convert_to_integer(part, yy, rc = status) + _ASSERT(status == 0, 'Unable to convert year string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, mm, rc = status) + _ASSERT(status == 0, 'Unable to convert month string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, dd, rc = status) + _ASSERT(status == 0, 'Unable to convert day string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, h, rc = status) + _ASSERT(status == 0, 'Unable to convert hour string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, m, rc = status) + _ASSERT(status == 0, 'Unable to convert minute string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, s, rc = status) + _ASSERT(status == 0, 'Unable to convert second string') + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time + + function is_valid_netcdf_datetime_string(string) result(tval) + character(len=*), parameter :: DIGITS = '0123456789' + character(len=*), intent(in) :: string + logical :: tval + integer :: i + + tval = .false. + + if(len(trim(string)) /= len(NETCDF_DATETIME)) return + + do i=1, len_trim(string) + if(scan(NETCDF_DATETIME(i:i), DIGITS) > 0) then + if(scan(string(i:i), DIGITS) <= 0) return + else + if(string(i:i) /= NETCDF_DATETIME(i:i)) return + end if + end do + + tval = .true. + + end function is_valid_netcdf_datetime_string + + function is_time_unit(tunit) + character(len=*), intent(in) :: tunit + logical :: is_time_unit + integer :: i + + is_time_unit = .TRUE. + do i = 1, size(TIME_UNITS) + if(adjustl(tunit) == adjustl(TIME_UNITS(i))) return + end do + is_time_unit = .FALSE. + + end function is_time_unit + + ! Get the sign of integer represening a time span based on preposition + function get_shift_sign(preposition) + character(len=*), intent(in) :: preposition + integer :: get_shift_sign + integer, parameter :: POSITIVE = 1 + get_shift_sign = 0 + if(adjustl(preposition) == 'since') get_shift_sign = POSITIVE + end function get_shift_sign + + ! Split string at delimiter + function split_chars(chars, delimiter) result(pair) + character(len=*), intent(in) :: chars + character(len=*), intent(in) :: delimiter + character(len=len(chars)) :: pair(2) + integer start + + pair = ['', ''] + + start = index(chars, delimiter) + if(start == 0) then + pair(1) = chars + return + end if + + pair(1) = chars(1:(start - 1)) + pair(2) = chars((start+len(delimiter)):len_trim(chars)) + + end function split_chars + + function split_all_iterative(string, delimiter) result(parts) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: delimiter + character(len=:), allocatable :: parts(:) + character(len=:), allocatable :: pair(:) + character(len=:), allocatable :: head + character(len=:), allocatable :: tail + + parts = [trim(string)] + + if((len(string) == 0) .or. (len(delimiter) == 0)) return + + tail = parts(1) + parts = [character::] + do while (len(tail) > 0) + pair = split(tail, delimiter) + head = trim(pair(1)) + tail = trim(pair(2)) + if(len(head) > 0) parts = [parts, head] + end do + + end function split_all_iterative + + ! Split string into all substrings based on delimiter + function split_all_recursive(string, delimiter, recurse) result(parts) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: delimiter + logical , intent(in) :: recurse + character(len=:), allocatable :: parts(:) + + if(recurse) then + parts = splitter(trim(string), delimiter) + return + end if + + parts = split_all_iterative(string, delimiter) + contains + + recursive function splitter(string, delimiter) result(parts) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: delimiter + character(len=:), allocatable :: parts(:) + character(len=:), allocatable :: head + character(len=:), allocatable :: tail(:) + integer :: next, last + + last = index(string, delimiter) - 1 + + if(last < 0) then + parts = [string] + else + head = string(1:last) + next = last + len(delimiter) + 1 + tail = splitter(string(next:len(string)), delimiter) + parts = [head, tail] + end if + + end function splitter + + end function split_all_recursive + + ! Convert string representing an integer to the integer + subroutine convert_to_integer(string_in, int_out, rc) + character(len=*), intent(in) :: string_in + integer, intent(out) :: int_out + integer, optional, intent(out) :: rc + integer :: stat + + read(string_in, '(I16)', iostat=stat) int_out + + if(present(rc)) rc = stat + + end subroutine convert_to_integer + end module MAPL_NetCDF +! function split_chararray(chararray, delimiter) result(parts) +! character(len=*), intent(in) :: chararray(:) +! character(len=*), intent(in) :: delimiter +! character(len=:), allocatable :: parts(:) +! +! if(size(chararray) == 0) then +! parts = chararray +! return +! end if +! +! parts = strip_empty([chararray(1:size(chararray)), split(chararray(size(chararray)), delimiter)]) +! +! end function split_chararray +! +! function strip_empty(chararray) result(stripped) +! character(len=*), intent(in) :: chararray +! character(len=:), allocatable:: stripped +! integer :: i +! +! stripped = [character::] +! +! do i = 1, size(chararray) +! if(len(chararray(i) > 0)) stripped = [stripped, chararray(i)] +! end do +! +! end function strip_empty + diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index fedc605a1edf..abe10fc0f8d6 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -21,26 +21,30 @@ contains end subroutine set_up + function make_datetime_string(yy, mm, dd, h, m, s) result(datetime_string) + integer, intent(in) :: yy, mm, dd, h, m, s + character(len=32) :: datetime_string + character(len=*), parameter :: fmt_string = '(I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' + integer :: iostat_ + + write(datetime_string, fmt=fmt_string, iostat=iostat_) yy, mm, dd, h, m, s + if(iostat_ == 0) return + datetime_string = '' + + end function make_datetime_string + function make_units_string(units, preposition, yy, mm, dd, h, m, s) result(units_string) character(len=*), intent(in) :: units character(len=*), intent(in) :: preposition integer, intent(in) :: yy, mm, dd, h, m, s - character(len=32) :: units_string - - character, parameter :: D = '-' - character, parameter :: T = ':' - character(len=*), parameter :: I2 = ', I2.2' - character(len=*), parameter :: OA = '(A' // ', 1X, A, 1X' - character(len=*), parameter :: YMD = ', I4.4'// D // I2 // D // I2 - character(len=*), parameter :: HMS = ', 1X' // I2 // T // I2 // T // I2 // ')' -! character(len=*), parameter :: fmt_string = OA // YMD // HMS - integer :: status - - character(len=*), parameter :: fmt_string = '(A, 1X, A, 1X, I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' - write(units_string, fmt=fmt_string, iostat=status) trim(units), trim(preposition), yy, mm, dd, h, m, s - if(status == 0) return + character(len=132) :: units_string + character(len=:), allocatable :: datetime_string + character(len=*), parameter :: SPACE = ' ' units_string = '' + datetime_string = make_datetime_string(yy, mm, dd, h, m, s) + if(len_trim(datetime_string) == 0) return + units_string = trim(units) // SPACE // trim(preposition) // SPACE // datetime_string end function make_units_string @@ -49,7 +53,51 @@ contains ESMF_Times_Equal = (timeu == timev) end function ESMF_Times_Equal - @Test +! @Test + subroutine test_make_datetime_string() + integer, parameter :: YY = 1999 + integer, parameter :: MM = 12 + integer, parameter :: DD = 31 + integer, parameter :: H = 23 + integer, parameter :: M = 59 + integer, parameter :: S = 59 + + character(len=*), parameter :: EXPECTED_DATETIME_STRING = '1999-12-31 23:59:59' + integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_DATETIME_STRING) + + character(len=:), allocatable :: actual_datetime_string + + actual_datetime_string = make_datetime_string(yy, mm, dd, h, m, s) + @assertEqual(EXPECTED_LENGTH, len_trim(actual_datetime_string), 'Incorrect length for datetime string') + @assertEqual(EXPECTED_DATETIME_STRING, trim(actual_datetime_string), 'Datetime strings do not match.') + + end subroutine test_make_datetime_string + +! @Test + subroutine test_make_units_string() + integer, parameter :: YY = 1999 + integer, parameter :: MM = 12 + integer, parameter :: DD = 31 + integer, parameter :: H = 23 + integer, parameter :: M = 59 + integer, parameter :: S = 59 + + character(len=*), parameter :: SPACE = ' ' + character(len=*), parameter :: EXPECTED_UNITS = 'seconds' + character(len=*), parameter :: EXPECTED_PREPOSITION = 'since' + character(len=*), parameter :: EXPECTED_UNITS_STRING = EXPECTED_UNITS // & + SPACE // EXPECTED_PREPOSITION // SPACE // '1999-12-31 23:59:59' + integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_UNITS_STRING) + + character(len=:), allocatable :: actual_units_string + + actual_units_string = make_units_string(EXPECTED_UNITS, EXPECTED_PREPOSITION, YY, MM, DD, H, M, S) + @assertEqual(EXPECTED_LENGTH, len_trim(actual_units_string), "Incorrect length for actual_units_string") + @assertEqual(EXPECTED_UNITS_STRING, actual_units_string, "Units_string's do not match.") + + end subroutine test_make_units_string + +! @Test subroutine test_convert_NetCDF_DateTime_to_ESMF() character(len=*), parameter :: expected_tunit = 'seconds' integer, parameter :: int_time = 1800 @@ -77,7 +125,7 @@ contains end subroutine test_convert_NetCDF_DateTime_to_ESMF - @Test +! @Test subroutine test_convert_ESMF_to_NetCDF_DateTime() character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' @@ -105,8 +153,8 @@ contains end subroutine test_convert_ESMF_to_NetCDF_DateTime - @Test - subroutine test_make_ESMF_TimeInterval() +! @Test + subroutine test_make_ESMF_TimeInterval_integer() character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' integer, parameter :: duration = 1800 @@ -120,27 +168,27 @@ contains call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') - end subroutine test_make_ESMF_TimeInterval + end subroutine test_make_ESMF_TimeInterval_integer - @Test - subroutine test_make_NetCDF_DateTime_duration() +! @Test + subroutine test_make_NetCDF_DateTime_duration_integer() character(len=*), parameter :: tunit = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' type(ESMF_TimeInterval) :: interval type(ESMF_Time) :: start_time - integer, parameter :: expected_int_time = 1800 - integer :: int_time + integer, parameter :: expected_duration = 1800 + integer :: duration integer :: status, rc call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_int_time, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) - call make_NetCDF_DateTime_duration(interval, start_time, tunit, int_time, _RC) - @assertEqual(expected_int_time, int_time, 'int_time does not match.') + call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) + @assertEqual(expected_duration, duration, 'duration does not match.') - end subroutine test_make_NetCDF_DateTime_duration + end subroutine test_make_NetCDF_DateTime_duration_integer - @Test +! @Test subroutine test_make_NetCDF_DateTime_units_string() type(ESMF_Time) :: start_time character(len=*), parameter :: tunit = 'seconds' @@ -155,7 +203,7 @@ contains @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) end subroutine test_make_NetCDF_DateTime_units_string - @Test +! @Test subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() type(ESMF_Time) :: esmf_datetime character(len=*), parameter :: expected = '2022-08-26 07:30:37' @@ -173,7 +221,7 @@ contains @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString - @Test +! @Test subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' type(ESMF_Time) :: etime @@ -221,43 +269,64 @@ contains @assertFalse(get_shift_sign(preposition) == expected) end subroutine test_get_shift_sign -! @test - subroutine test_split() + @test + subroutine test_split_chars() character(len=*), parameter :: head = 'head' character(len=*), parameter :: tail = 'tail' character(len=*), parameter :: delim = '::' - character(len=*), parameter :: test_string = head // delim // tail + character(len=:), allocatable :: test_string character(len=:), allocatable :: parts(:) - parts = split_all(test_string, delim) - @assertEqual(2, size(parts)) - @assertEqual(head, parts(1)) - @assertEqual(tail, parts(2)) - - end subroutine test_split - -! @test - subroutine test_split_all() - character(len=4), parameter :: chunk(6) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] - character(len=*), parameter :: dlm = '::' + test_string = head // delim // tail + parts = split(test_string, delim) + @assertEqual(2, size(parts), 'Two parts expected.') + @assertEqual(head, parts(1), 'Part 1 does not match head.') + @assertEqual(tail, parts(2), 'Part 2 does not match tail.') + + test_string = delim // tail + parts = split(test_string, delim) + @assertEqual(tail, parts(2), 'Part 2 does not match tail.') + @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') + + test_string = head // delim + parts = split(test_string, delim) + @assertEqual(head, parts(1), 'Part 1 does not match head.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + test_string = head // ' ' // tail + parts = split(test_string, delim) + @assertEqual(test_string, parts(1), 'Part 1 does not match test_string.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + test_string = '' + parts = split(test_string, delim) + @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + end subroutine test_split_chars + + @test + subroutine test_split_all_iterative() + integer, parameter :: N = 6 + integer, parameter :: SLEN = 4 + character(len=SLEN), parameter :: chunk(N) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] + character(len=:), allocatable :: dlm character(len=:), allocatable :: test_string character(len=:), allocatable :: parts(:) integer :: i - test_string = chunk(1) - do i = 2, size(chunk) - test_string = test_string // dlm // chunk(i) - end do + dlm = ' ' + test_string = 'mice' // dlm // 'dogs' // dlm // 'rats' // dlm // 'fish' // dlm // 'deer' // dlm // 'pigs' parts = split_all(test_string, dlm) - @assertEqual(size(parts), size(chunk)) + @assertEqual(size(parts), size(chunk), 'Number of parts do not match.') do i = 1, size(chunk) @assertEqual(chunk(i), parts(i)) end do - end subroutine test_split_all + end subroutine test_split_all_iterative -! @test + @test subroutine test_is_valid_netcdf_datetime_string() character(len=:), allocatable :: string @@ -281,7 +350,7 @@ contains end subroutine test_is_valid_netcdf_datetime_string -! @test + @test subroutine test_convert_to_integer() character(len=:), allocatable :: str integer :: expected, actual, status @@ -297,18 +366,78 @@ contains ! @test subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer() - character, parameter :: D = '-' - character, parameter :: T = ':' - character(len=*), parameter :: I2 = ', I2.2' - character(len=*), parameter :: OA = '(A' // ', 1X, A, 1X' - character(len=*), parameter :: YMD = ', I4.4'// D // I2 // D // I2 - character(len=*), parameter :: HMS = ', 1X' // I2 // T // I2 // T // I2 // ')' - character(len=*), parameter :: fmt_string = OA // YMD // HMS - integer :: duration integer :: yy, mm, dd, h, m, s character(len=:), allocatable :: units character(len=:), allocatable :: preposition + character(len=:), allocatable :: units_string + type(ESMF_Time) :: time, esmf_time + integer :: status + + duration=1800 + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 59 + s = 59 + units = 'seconds' + preposition = 'since' + + units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) + @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") + + call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertEqual(0, status, 'Unable to create expected ESMF_Time') + @assertEqual(0, status, 'Unable to print ESMF_Time') + + call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) + @assertEqual(0, status, 'Conversion failed') + + @assertTrue(ESMF_Times_Equal(esmf_time, time), "ESMF_Time's don't match.") + + end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer + +! @test + subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() + integer, parameter :: SECONDS_PER_MINUTE = 60 + type(ESMF_Time) :: time + character(len=:), allocatable :: units_string + integer :: duration, expected_duration, duration_in_minutes + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition + integer :: yy, mm, dd, h, m, s + integer :: status + + expected_duration=1800 + duration_in_minutes = expected_duration/SECONDS_PER_MINUTE + yy = 1999 + mm = 12 + dd = 31 + h = 23 + m = 29 + s = 59 + units = 'seconds' + preposition = 'since' + + units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) + @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + + call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m+duration_in_minutes, s=s, rc = status) + @assertEqual(0, status, 'Failed to create ESMF_Time') + + call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) + @assertEqual(0, status, 'Failed to get duration time') + @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') + + end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer + +! @test + subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real() + real(kind=ESMF_KIND_R8) :: duration + integer :: yy, mm, dd, h, m, s + character(len=:), allocatable :: units + character(len=:), allocatable :: preposition character(len=32) :: units_string type(ESMF_Time) :: time, esmf_time integer :: status @@ -334,13 +463,48 @@ contains @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Times''s don''t match.') - end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer + end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real ! @test - subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() + subroutine test_make_ESMF_TimeInterval_real() + character(len=*), parameter :: units = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + real(kind=ESMF_KIND_R8), parameter :: duration = 1800 + type(ESMF_TimeInterval) :: expected_interval + type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + integer :: rc, status + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s_r8=duration, _RC) + call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) + @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') + + end subroutine test_make_ESMF_TimeInterval_real + +! @Test + subroutine test_make_NetCDF_DateTime_duration_real() + character(len=*), parameter :: tunit = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time + real(kind=ESMF_KIND_R8), parameter :: expected_duration = 1800 + real(kind=ESMF_KIND_R8) :: duration + integer :: status, rc + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=expected_duration, _RC) + + call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) + @assertEqual(expected_duration, duration, 'int_time does not match.') + + end subroutine test_make_NetCDF_DateTime_duration_real + +! @test + subroutine test_get_NetCDF_duration_from_ESMF_Time_real() type(ESMF_Time) :: time character(len=:), allocatable :: units_string - integer :: duration, expected_duration + real(kind=ESMF_KIND_R8) :: duration, expected_duration character(len=:), allocatable :: units character(len=:), allocatable :: preposition integer :: yy, mm, dd, h, m, s @@ -366,14 +530,75 @@ contains @assertEqual(0, status, 'Failed to create time') @assertEqual(expected_duration, duration, 'Expected duration does not match expected duration.') - end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer + end subroutine test_get_NetCDF_duration_from_ESMF_Time_real +end module test_MAPL_NetCDF ! @test - subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time_integer() - end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time_integer - +! subroutine test_split_chararray() +! character(len=*), parameter :: head = 'head' +! character(len=*), parameter :: tail = 'tail' +! character(len=*), parameter :: delim = '::' +! character(len=:), allocatable :: parts(:) +! +! parts = [character::] +! parts = split(parts, delimiter) +! @assertEqual(0, size(parts)) +! +! parts = [ head // delim // tail ] +! parts = split(parts, delim) +! @assertEqual(2, size(parts)) +! @assertEqual(head, parts(1), 'Part 1 does not match head.') +! @assertEqual(tail, parts(2), 'Part 2 does not match tail.') +! +! parts = [ delim // tail ] +! parts = split(parts, delim) +! @assertEqual(1, size(parts)) +! @assertEqual(tail, parts(1), 'Part 1 does not match tail.') +! +! parts = [ head // delim ] +! parts = split(parts, delim) +! @assertEqual(1, size(parts)) +! @assertEqual(head, parts(1), 'Part 1 does not match head.') +! end subroutine test_split_chararray +! ! @test - subroutine test_make_ESMF_TimeInterval_integer() - end subroutine test_make_ESMF_TimeInterval_integer - -end module test_MAPL_NetCDF +! subroutine test_strip_empty() +! character(len=:), allocatable :: chararray +! character(len=*), parameter :: ALL_CHARS = [ 'AAA', 'BBB', 'CCC' ] +! integer :: i, missing +! +! charray = ALL_CHARS +! charray = strip_empty(chararray) +! @assertEqual(size(ALL_CHARS), size(chararray), 'Number of elements do not match.') +! do i = 1, size(charray) +! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') +! end do +! +! charray = [ALL_CHARS(1), ALL_CHARS(2), ''] +! missing = 3 +! charray = strip_empty(chararray) +! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') +! do i = 1, size(charray) +! if(i == missing) cycle +! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') +! end do +! +! charray = ['', ALL_CHARS(2), ALL_CHARS(3)] +! missing = 1 +! charray = strip_empty(chararray) +! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') +! do i = 1, size(charray) +! if(i == missing) cycle +! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') +! end do +! +! charray = [ALL_CHARS(1), '', ALL_CHARS(3)] +! missing = 2 +! charray = strip_empty(chararray) +! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') +! do i = 1, size(charray) +! if(i == missing) cycle +! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') +! end do +! +! end subroutine test_strip_empty From 8c0f21c7ff8e05158897f6be423ddee8a0778605 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 1 Jun 2023 00:20:15 -0400 Subject: [PATCH 03/32] Fix bugs in testing --- base/MAPL_NetCDF.F90 | 405 ++++++++++++++++++--------------- base/tests/test_MAPL_NetCDF.pf | 151 +++++++----- 2 files changed, 317 insertions(+), 239 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 799c0c62b556..74664ff3e1ac 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -89,6 +89,9 @@ module MAPL_NetCDF contains +!=============================================================================== +!========================= OLD HIGH-LEVEL PROCEDURES =========================== + ! Convert NetCDF_DateTime {int_time, units_string} to ! ESMF time variables {interval, start_time, time} and time unit {tunit} ! start_time is the start time, and time is start_time + interval @@ -172,69 +175,9 @@ subroutine convert_ESMF_to_NetCDF_DateTime(tunit, start_time, int_time, units_st end subroutine convert_ESMF_to_NetCDF_DateTime - ! Make ESMF_TimeInterval from a span of time, time unit, and start time - subroutine make_ESMF_TimeInterval_integer(span, tunit, start_time, interval, unusable, rc) - integer, intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: start_time - type(ESMF_TimeInterval), intent(inout) :: interval - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - select case(trim(adjustl(tunit))) - case('years') - call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) - case('months') - call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=start_time, h=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=start_time, m=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=span, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_ESMF_TimeInterval_integer - - ! Get time span from NetCDF datetime - ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (integer) - subroutine make_NetCDF_DateTime_duration_integer(interval, start_time, units, duration, unusable, rc) - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: start_time - character(len=*), intent(in) :: units - integer, intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - ! get duration - select case(trim(adjustl(units))) - case('years') - call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) - case('months') - call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) - case('hours') - call ESMF_TimeIntervalGet(interval, start_time, h=duration, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, start_time, m=duration, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, start_time, s=duration, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_duration_integer +!========================= END OLD HIGH-LEVEL PROCEDURES ======================= +!=============================================================================== +!========================= OLD LOWER-LEVEL PROCEDURES ========================== ! Make 'units' for NetCDF datetime subroutine make_NetCDF_DateTime_units_string(start_time, tunit, units_string, unusable, rc) @@ -304,57 +247,56 @@ subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_st end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString - subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & - units_string, time, unusable, rc) - integer, intent(in) :: duration - character(len=*), intent(in) :: units_string +!======================= END OLD LOWER-LEVEL PROCEDURES ======================== +!=============================================================================== +!========================= NEW HIGH-LEVEL PROCEDURES =========================== + + ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) + subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) + type(ESMF_Time), intent(inout) :: time + character(len=:), allocatable, intent(in) :: units_string + integer, intent(out) :: duration class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), intent(inout) :: time integer, optional, intent(out) :: rc - character(len=:), allocatable :: parts(:) - type(ESMF_TimeInterval) :: interval type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + character(len=:), allocatable :: parts(:) character(len=:), allocatable :: units character(len=:), allocatable :: preposition - character(len=LEN_DATE) :: date_string - character(len=LEN_TIME) :: time_string - character(len=LEN_DATETIME) :: datetime_string - integer :: signed_duration, sign_factor + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string integer :: status + integer(ESMF_KIND_I8) :: sign_factor _UNUSED_DUMMY(unusable) - - _ASSERT(duration >= 0, 'Negative duration not supported') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(units_string, PART_DELIM) + parts = split_all(trim(units_string), PART_DELIM) _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') units = adjustl(parts(1)) preposition = adjustl(parts(2)) date_string = adjustl(parts(3)) time_string = adjustl(parts(4)) - datetime_string = date_string // PART_DELIM // time_string + call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + interval = time - start_time + + call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - signed_duration = sign_factor * duration - - call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) - call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) - - time = start_time + interval + duration = sign_factor * duration _RETURN(_SUCCESS) + + end subroutine get_NetCDF_duration_from_ESMF_Time_integer - end subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer - - ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) - subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) + subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, unusable, rc) type(ESMF_Time), intent(inout) :: time character(len=:), allocatable, intent(in) :: units_string - integer, intent(out) :: duration + real(kind=ESMF_KIND_R8), intent(out) :: duration class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -372,7 +314,7 @@ subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, durati _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(trim(units_string), PART_DELIM) + parts = split_all(units_string, PART_DELIM) _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') units = adjustl(parts(1)) @@ -390,11 +332,11 @@ subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, durati _RETURN(_SUCCESS) - end subroutine get_NetCDF_duration_from_ESMF_Time_integer + end subroutine get_NetCDF_duration_from_ESMF_Time_real - subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & + subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & units_string, time, unusable, rc) - real(kind=ESMF_KIND_R8), intent(in) :: duration + integer, intent(in) :: duration character(len=*), intent(in) :: units_string class (KeywordEnforcer), optional, intent(in) :: unusable type(ESMF_Time), intent(inout) :: time @@ -405,9 +347,10 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & type(ESMF_Time) :: start_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string - real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor + character(len=LEN_DATE) :: date_string + character(len=LEN_TIME) :: time_string + character(len=LEN_DATETIME) :: datetime_string + integer :: signed_duration, sign_factor integer :: status _UNUSED_DUMMY(unusable) @@ -422,131 +365,80 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & preposition = adjustl(parts(2)) date_string = adjustl(parts(3)) time_string = adjustl(parts(4)) + datetime_string = date_string // PART_DELIM // time_string sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') signed_duration = sign_factor * duration - call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) time = start_time + interval _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTime_to_ESMF_Time_real - - subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusable, rc) - real(kind=ESMF_KIND_R8), intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: start_time - type(ESMF_TimeInterval), intent(inout) :: interval - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - select case(trim(adjustl(tunit))) - case('years') - _FAIL('Real values for years are not supported.') -! call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) - case('months') - _FAIL('Real values for months are not supported.') -! call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) - case('days') - _FAIL('Real values for days are not supported.') - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=start_time, h_r8=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=start_time, m_r8=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=span, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_ESMF_TimeInterval_real - - ! Get time span from NetCDF datetime - ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (real) - subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, duration, unusable, rc) - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: start_time - character(len=*), intent(in) :: units - real(kind=ESMF_KIND_R8), intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - ! get duration - select case(trim(adjustl(units))) - case('years') - _FAIL('Real values for years are not supported.') -! call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) - case('months') - _FAIL('Real values for months are not supported.') -! call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) - case('days') - _FAIL('Real values for days are not supported.') - case('hours') - call ESMF_TimeIntervalGet(interval, start_time, h_r8=duration, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, start_time, m_r8=duration, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, start_time, s_r8=duration, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_duration_real + end subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer - subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, unusable, rc) - type(ESMF_Time), intent(inout) :: time - character(len=:), allocatable, intent(in) :: units_string - real(kind=ESMF_KIND_R8), intent(out) :: duration + subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & + units_string, time, unusable, rc) + real(kind=ESMF_KIND_R8), intent(in) :: duration + character(len=*), intent(in) :: units_string class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), intent(inout) :: time integer, optional, intent(out) :: rc - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval character(len=:), allocatable :: parts(:) + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition character(len=:), allocatable :: date_string character(len=:), allocatable :: time_string + character(len=:), allocatable :: datetime_string !wdb fixme deleteme + real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor integer :: status - integer(ESMF_KIND_I8) :: sign_factor _UNUSED_DUMMY(unusable) - + + _ASSERT(duration >= 0, 'Negative duration not supported') _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') parts = split_all(units_string, PART_DELIM) _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') units = adjustl(parts(1)) + print *, 'units: ', units !wdb fixme deleteme preposition = adjustl(parts(2)) + print *, 'preposition: ', preposition !wdb fixme deleteme date_string = adjustl(parts(3)) + print *, 'date_string: ', date_string !wdb fixme deleteme time_string = adjustl(parts(4)) + print *, 'time_string: ', time_string !wdb fixme deleteme - call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) - interval = time - start_time - - call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - duration = sign_factor * duration + print *, 'sign_factor = ', sign_factor !wdb fixme deleteme + signed_duration = sign_factor * duration + print *, 'signed_duration = ', signed_duration + datetime_string = date_string // PART_DELIM // time_string !wdb fixme deleteme + print *, 'datetime string: ' // datetime_string !wdb fixme deleteme +! call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) !wdb fixme deleteme + call ESMF_TimePrint(start_time, options='string', _RC) !wdb fixme deleteme + call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) + call ESMF_TimeIntervalPrint(interval, options='string', _RC) !wdb fixme deleteme + + time = start_time + interval + call ESMF_TimePrint(time, options='string', _RC) !wdb fixme deleteme _RETURN(_SUCCESS) - - end subroutine get_NetCDF_duration_from_ESMF_Time_real + + end subroutine convert_NetCDF_DateTime_to_ESMF_Time_real + +!======================= END NEW HIGH-LEVEL PROCEDURES ========================= +!=============================================================================== +!========================= NEW LOWER-LEVEL PROCEDURES ========================== ! Convert NetCDF datetime to ESMF_Time subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) @@ -560,7 +452,8 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, _UNUSED_DUMMY(unusable) - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), & + 'Invalid datetime string: ' // datetime_string) i = 1 j = i + 3 @@ -604,6 +497,145 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time + ! Make ESMF_TimeInterval from a span of time, time unit, and start time + subroutine make_ESMF_TimeInterval_integer(span, tunit, start_time, interval, unusable, rc) + integer, intent(in) :: span + character(len=*), intent(in) :: tunit + type(ESMF_Time), intent(inout) :: start_time + type(ESMF_TimeInterval), intent(inout) :: interval + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + select case(trim(adjustl(tunit))) + case('years') + call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) + case('months') + call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) + case('hours') + call ESMF_TimeIntervalSet(interval, startTime=start_time, h=span, _RC) + case('minutes') + call ESMF_TimeIntervalSet(interval, startTime=start_time, m=span, _RC) + case('seconds') + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=span, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_ESMF_TimeInterval_integer + + subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusable, rc) + real(kind=ESMF_KIND_R8), intent(in) :: span + character(len=*), intent(in) :: tunit + type(ESMF_Time), intent(inout) :: start_time + type(ESMF_TimeInterval), intent(inout) :: interval + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + select case(trim(adjustl(tunit))) + case('years') + _FAIL('Real values for years are not supported.') +! call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) + case('months') + _FAIL('Real values for months are not supported.') +! call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) + case('days') + _FAIL('Real values for days are not supported.') + case('hours') + call ESMF_TimeIntervalSet(interval, startTime=start_time, h_r8=span, _RC) + case('minutes') + call ESMF_TimeIntervalSet(interval, startTime=start_time, m_r8=span, _RC) + case('seconds') + call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=span, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_ESMF_TimeInterval_real + + ! Get time span from NetCDF datetime + ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (integer) + subroutine make_NetCDF_DateTime_duration_integer(interval, start_time, units, duration, unusable, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: start_time + character(len=*), intent(in) :: units + integer, intent(out) :: duration + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + ! get duration + select case(trim(adjustl(units))) + case('years') + call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) + case('months') + call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) + case('hours') + call ESMF_TimeIntervalGet(interval, start_time, h=duration, _RC) + case('minutes') + call ESMF_TimeIntervalGet(interval, start_time, m=duration, _RC) + case('seconds') + call ESMF_TimeIntervalGet(interval, start_time, s=duration, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_NetCDF_DateTime_duration_integer + + ! Get time span from NetCDF datetime + ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (real) + subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, duration, unusable, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: start_time + character(len=*), intent(in) :: units + real(kind=ESMF_KIND_R8), intent(out) :: duration + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + ! get duration + select case(trim(adjustl(units))) + case('years') + _FAIL('Real values for years are not supported.') +! call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) + case('months') + _FAIL('Real values for months are not supported.') +! call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) + case('days') + _FAIL('Real values for days are not supported.') + case('hours') + call ESMF_TimeIntervalGet(interval, start_time, h_r8=duration, _RC) + case('minutes') + call ESMF_TimeIntervalGet(interval, start_time, m_r8=duration, _RC) + case('seconds') + call ESMF_TimeIntervalGet(interval, start_time, s_r8=duration, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_NetCDF_DateTime_duration_real + +!======================= END NEW LOWER-LEVEL PROCEDURES ======================== +!=============================================================================== +!============================= UTILITY PROCEDURES ============================== + function is_valid_netcdf_datetime_string(string) result(tval) character(len=*), parameter :: DIGITS = '0123456789' character(len=*), intent(in) :: string @@ -742,6 +774,9 @@ subroutine convert_to_integer(string_in, int_out, rc) end subroutine convert_to_integer +!=========================== END UTILITY PROCEDURES ============================ +!=============================================================================== + end module MAPL_NetCDF ! function split_chararray(chararray, delimiter) result(parts) ! character(len=*), intent(in) :: chararray(:) diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index abe10fc0f8d6..db14ab39e218 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -9,7 +9,10 @@ module test_MAPL_NetCDF implicit none type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG_DEF = ESMF_CALKIND_GREGORIAN + integer, parameter :: SUCCESS = 0 + integer, parameter :: SECONDS_PER_MINUTE = 60 + contains @Before @@ -17,7 +20,7 @@ contains integer :: status call ESMF_CalendarSetDefault(CALKIND_FLAG_DEF, rc=status) - if(status /= 0) write(*, *) 'Failed to set ESMF_Calendar' + if(status /= SUCCESS) write(*, *) 'Failed to set ESMF_Calendar' end subroutine set_up @@ -28,7 +31,7 @@ contains integer :: iostat_ write(datetime_string, fmt=fmt_string, iostat=iostat_) yy, mm, dd, h, m, s - if(iostat_ == 0) return + if(iostat_ == SUCCESS) return datetime_string = '' end function make_datetime_string @@ -48,12 +51,50 @@ contains end function make_units_string + logical function qequal(na, nb) + integer, intent(in) :: na(2) + integer, intent(in) :: nb(2) + + qequal = ( na(1) * nb(2) == na(2) * nb(1) ) + + end function qequal + logical function ESMF_Times_Equal(timeu, timev) type(ESMF_Time), intent(in) :: timeu, timev - ESMF_Times_Equal = (timeu == timev) + integer :: uyy, umm, udd, uh, um, us, usN, usD + integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD + integer :: status + + call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) + call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) + + ESMF_Times_Equal = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & + .and. (uh == vh) .and. (um == vm) .and. (us == vs) & + .and. qequal([usN, usD], [vsN, vsD]) ) + end function ESMF_Times_Equal -! @Test + @Test + subroutine test_ESMF_Times_Equal() + integer :: yy = 1957 + integer :: mm = 10 + integer :: dd = 19 + integer :: h = 18 + integer :: m = 37 + integer :: s = 53 + type(ESMF_Time) :: timea, timeb + integer :: status + + call ESMF_TimeSet(timea, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create timea') + call ESMF_TimeSet(timeb, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create timeb') + @assertTrue(timea == timeb, 'ESMF_Time values are not equal.') + @assertTrue(ESMF_Times_Equal(timea, timeb), 'ESMF_Time values do not match.') + + end subroutine test_ESMF_Times_Equal + + @Test subroutine test_make_datetime_string() integer, parameter :: YY = 1999 integer, parameter :: MM = 12 @@ -73,7 +114,7 @@ contains end subroutine test_make_datetime_string -! @Test + @Test subroutine test_make_units_string() integer, parameter :: YY = 1999 integer, parameter :: MM = 12 @@ -97,7 +138,7 @@ contains end subroutine test_make_units_string -! @Test + @Test subroutine test_convert_NetCDF_DateTime_to_ESMF() character(len=*), parameter :: expected_tunit = 'seconds' integer, parameter :: int_time = 1800 @@ -125,7 +166,7 @@ contains end subroutine test_convert_NetCDF_DateTime_to_ESMF -! @Test + @Test subroutine test_convert_ESMF_to_NetCDF_DateTime() character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' @@ -153,7 +194,7 @@ contains end subroutine test_convert_ESMF_to_NetCDF_DateTime -! @Test + @Test subroutine test_make_ESMF_TimeInterval_integer() character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' @@ -170,7 +211,7 @@ contains end subroutine test_make_ESMF_TimeInterval_integer -! @Test + @Test subroutine test_make_NetCDF_DateTime_duration_integer() character(len=*), parameter :: tunit = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' @@ -188,7 +229,7 @@ contains end subroutine test_make_NetCDF_DateTime_duration_integer -! @Test + @Test subroutine test_make_NetCDF_DateTime_units_string() type(ESMF_Time) :: start_time character(len=*), parameter :: tunit = 'seconds' @@ -197,13 +238,13 @@ contains integer :: status call ESMF_TimeSet(start_time, yy=2012, mm=08, dd=26, h=08, m=36, s=37, rc=status) - @assertEqual(status, 0, 'Failed to set ESMF_Time') + @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') call make_NetCDF_DateTime_units_string(start_time, tunit, actual, rc=status) - @assertEqual(0, status, 'Failed to make units_string') + @assertTrue(status == SUCCESS, 'Failed to make units_string') @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) end subroutine test_make_NetCDF_DateTime_units_string -! @Test + @Test subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() type(ESMF_Time) :: esmf_datetime character(len=*), parameter :: expected = '2022-08-26 07:30:37' @@ -221,7 +262,7 @@ contains @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString -! @Test + @Test subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' type(ESMF_Time) :: etime @@ -239,7 +280,7 @@ contains end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time -! @Test + @Test subroutine test_is_time_unit() @assertTrue(is_time_unit('years')) @@ -256,7 +297,7 @@ contains end subroutine test_is_time_unit -! @test + @test subroutine test_get_shift_sign() character(len=:), allocatable :: preposition integer, parameter :: expected = 1 @@ -354,118 +395,119 @@ contains subroutine test_convert_to_integer() character(len=:), allocatable :: str integer :: expected, actual, status - integer, parameter :: SUCCESSFUL = 0 expected = 2023 str = '2023' call convert_to_integer(str, actual, rc = status) - @assertEqual(SUCCESSFUL, status, 'Unsuccessful conversion: ' // str) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) @assertEqual(expected, actual, 'Incorrect conversion: ' // str) end subroutine test_convert_to_integer -! @test + @test subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer() integer :: duration - integer :: yy, mm, dd, h, m, s + integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition character(len=:), allocatable :: units_string type(ESMF_Time) :: time, esmf_time integer :: status - duration=1800 yy = 1999 mm = 12 dd = 31 h = 23 - m = 59 + m = 29 + m_time = 59 s = 59 units = 'seconds' preposition = 'since' + duration = ( m_time - m ) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") - call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertEqual(0, status, 'Unable to create expected ESMF_Time') - @assertEqual(0, status, 'Unable to print ESMF_Time') + call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) - @assertEqual(0, status, 'Conversion failed') + @assertTrue(status == SUCCESS, 'Conversion failed') - @assertTrue(ESMF_Times_Equal(esmf_time, time), "ESMF_Time's don't match.") + @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer -! @test + @test subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() - integer, parameter :: SECONDS_PER_MINUTE = 60 type(ESMF_Time) :: time character(len=:), allocatable :: units_string - integer :: duration, expected_duration, duration_in_minutes + integer :: duration, expected_duration character(len=:), allocatable :: units character(len=:), allocatable :: preposition - integer :: yy, mm, dd, h, m, s + integer :: yy, mm, dd, h, m, s, m_time integer :: status - expected_duration=1800 - duration_in_minutes = expected_duration/SECONDS_PER_MINUTE yy = 1999 mm = 12 dd = 31 h = 23 m = 29 + m_time = 59 s = 59 units = 'seconds' preposition = 'since' + expected_duration = (m_time - m) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m+duration_in_minutes, s=s, rc = status) - @assertEqual(0, status, 'Failed to create ESMF_Time') + call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create ESMF_Time') call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) - @assertEqual(0, status, 'Failed to get duration time') + @assertTrue(status == SUCCESS, 'Failed to get duration time') @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer -! @test + @test subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real() real(kind=ESMF_KIND_R8) :: duration - integer :: yy, mm, dd, h, m, s + integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition - character(len=32) :: units_string + character(len=:), allocatable :: units_string type(ESMF_Time) :: time, esmf_time integer :: status - duration=1800 yy = 1999 mm = 12 dd = 31 h = 23 - m = 59 + m = 29 + m_time = 59 s = 59 units = 'seconds' preposition = 'since' + duration = ( m_time - m ) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertEqual(0, status, 'Unable to create expected ESMF_Time') + call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimePrint(esmf_time, options='string', rc = status) !wdb fixme deleteme call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) - @assertEqual(0, status, 'Conversion failed') + @assertTrue(status == SUCCESS, 'Conversion failed') + call ESMF_TimePrint(time, options='string', rc = status) !wdb fixme deleteme - @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Times''s don''t match.') + @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real -! @test + @test subroutine test_make_ESMF_TimeInterval_real() character(len=*), parameter :: units = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' @@ -482,7 +524,7 @@ contains end subroutine test_make_ESMF_TimeInterval_real -! @Test + @Test subroutine test_make_NetCDF_DateTime_duration_real() character(len=*), parameter :: tunit = 'seconds' character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' @@ -500,35 +542,36 @@ contains end subroutine test_make_NetCDF_DateTime_duration_real -! @test + @test subroutine test_get_NetCDF_duration_from_ESMF_Time_real() type(ESMF_Time) :: time character(len=:), allocatable :: units_string real(kind=ESMF_KIND_R8) :: duration, expected_duration character(len=:), allocatable :: units character(len=:), allocatable :: preposition - integer :: yy, mm, dd, h, m, s + integer :: yy, mm, dd, h, m, s, m_time integer :: status - expected_duration=1800 yy = 1999 mm = 12 dd = 31 h = 23 m = 29 + m_time = 59 s = 59 units = 'seconds' preposition = 'since' + expected_duration = (m_time - m) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) - @assertEqual(0, status, 'Failed to create time') + call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create time') call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) - @assertEqual(0, status, 'Failed to create time') - @assertEqual(expected_duration, duration, 'Expected duration does not match expected duration.') + @assertTrue(status == SUCCESS, 'Failed to get duration time') + @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') end subroutine test_get_NetCDF_duration_from_ESMF_Time_real From 129b23dd2c8c388c0843b17a158dbd597c4909cc Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 1 Jun 2023 18:36:01 -0400 Subject: [PATCH 04/32] Comment out tests for old procedures --- base/tests/test_MAPL_NetCDF.pf | 220 ++++++++++++++++----------------- 1 file changed, 109 insertions(+), 111 deletions(-) diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index db14ab39e218..940b91bda387 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -138,61 +138,61 @@ contains end subroutine test_make_units_string - @Test - subroutine test_convert_NetCDF_DateTime_to_ESMF() - character(len=*), parameter :: expected_tunit = 'seconds' - integer, parameter :: int_time = 1800 - character(len=*), parameter :: units_string = expected_tunit // ' since 2012-08-26 12:36:37' - character(len=*), parameter :: start_time_iso_string = '2012-08-26T12:36:37' - character(len=*), parameter :: time_iso_string = '2012-08-26T13:06:37' - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: expected_start_time - type(ESMF_Time) :: expected_time - - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - type(ESMF_Time) :: time - character(len=:), allocatable :: tunit - integer :: rc, status - - call ESMF_TimeSet(expected_start_time, timeString=start_time_iso_string, _RC) - call ESMF_TimeSet(expected_time, timeString=time_iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=expected_start_time, s=int_time, _RC) - - call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, start_time, time=time, tunit=tunit, _RC) - @assertTrue(expected_start_time == start_time, 'Mismatch for start_time') - @assertTrue(expected_time == time, 'Mismatch for time') - @assertTrue(expected_interval == interval, 'Mismatch for interval') - - end subroutine test_convert_NetCDF_DateTime_to_ESMF - - @Test - subroutine test_convert_ESMF_to_NetCDF_DateTime() - character(len=*), parameter :: units = 'seconds' - character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' - type(ESMF_Time) :: start_time - character(len=*), parameter :: time_iso_string = '2013-08-26T13:04:56' - type(ESMF_Time) :: time - type(ESMF_TimeInterval) :: interval - integer, parameter :: expected_duration = 1800 - character(len=*), parameter :: expected_units_string = units // ' since 2013-08-26 12:34:56' - integer :: duration - character(len=:), allocatable :: units_string - integer :: rc, status - - call ESMF_TimeSet(start_time, start_time_iso_string, _RC) - call ESMF_TimeSet(time, time_iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) - - call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, time=time, _RC) - @assertEqual(expected_duration, duration, 'Using time, expected_duration /= duration') - @assertEqual(expected_units_string, units_string, 'Using time, expected_units_strin g/= units_string') - - call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, interval=interval, _RC) - @assertEqual(expected_duration, duration, 'Using interval, expected_duration /= duration') - @assertEqual(expected_units_string, units_string, 'Using interval, expected_units_strin g/= units_string') - - end subroutine test_convert_ESMF_to_NetCDF_DateTime +! @Test +! subroutine test_convert_NetCDF_DateTime_to_ESMF() +! character(len=*), parameter :: expected_tunit = 'seconds' +! integer, parameter :: int_time = 1800 +! character(len=*), parameter :: units_string = expected_tunit // ' since 2012-08-26 12:36:37' +! character(len=*), parameter :: start_time_iso_string = '2012-08-26T12:36:37' +! character(len=*), parameter :: time_iso_string = '2012-08-26T13:06:37' +! type(ESMF_TimeInterval) :: expected_interval +! type(ESMF_Time) :: expected_start_time +! type(ESMF_Time) :: expected_time +! +! type(ESMF_TimeInterval) :: interval +! type(ESMF_Time) :: start_time +! type(ESMF_Time) :: time +! character(len=:), allocatable :: tunit +! integer :: rc, status +! +! call ESMF_TimeSet(expected_start_time, timeString=start_time_iso_string, _RC) +! call ESMF_TimeSet(expected_time, timeString=time_iso_string, _RC) +! call ESMF_TimeIntervalSet(expected_interval, startTime=expected_start_time, s=int_time, _RC) +! +! call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, start_time, time=time, tunit=tunit, _RC) +! @assertTrue(expected_start_time == start_time, 'Mismatch for start_time') +! @assertTrue(expected_time == time, 'Mismatch for time') +! @assertTrue(expected_interval == interval, 'Mismatch for interval') +! +! end subroutine test_convert_NetCDF_DateTime_to_ESMF + +! @Test +! subroutine test_convert_ESMF_to_NetCDF_DateTime() +! character(len=*), parameter :: units = 'seconds' +! character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' +! type(ESMF_Time) :: start_time +! character(len=*), parameter :: time_iso_string = '2013-08-26T13:04:56' +! type(ESMF_Time) :: time +! type(ESMF_TimeInterval) :: interval +! integer, parameter :: expected_duration = 1800 +! character(len=*), parameter :: expected_units_string = units // ' since 2013-08-26 12:34:56' +! integer :: duration +! character(len=:), allocatable :: units_string +! integer :: rc, status +! +! call ESMF_TimeSet(start_time, start_time_iso_string, _RC) +! call ESMF_TimeSet(time, time_iso_string, _RC) +! call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) +! +! call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, time=time, _RC) +! @assertEqual(expected_duration, duration, 'Using time, expected_duration /= duration') +! @assertEqual(expected_units_string, units_string, 'Using time, expected_units_strin g/= units_string') +! +! call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, interval=interval, _RC) +! @assertEqual(expected_duration, duration, 'Using interval, expected_duration /= duration') +! @assertEqual(expected_units_string, units_string, 'Using interval, expected_units_strin g/= units_string') +! +! end subroutine test_convert_ESMF_to_NetCDF_DateTime @Test subroutine test_make_ESMF_TimeInterval_integer() @@ -229,38 +229,38 @@ contains end subroutine test_make_NetCDF_DateTime_duration_integer - @Test - subroutine test_make_NetCDF_DateTime_units_string() - type(ESMF_Time) :: start_time - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: expected = tunit // ' since 2012-08-26 08:36:37' - character(len=:), allocatable :: actual - integer :: status - - call ESMF_TimeSet(start_time, yy=2012, mm=08, dd=26, h=08, m=36, s=37, rc=status) - @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') - call make_NetCDF_DateTime_units_string(start_time, tunit, actual, rc=status) - @assertTrue(status == SUCCESS, 'Failed to make units_string') - @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) - end subroutine test_make_NetCDF_DateTime_units_string - - @Test - subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() - type(ESMF_Time) :: esmf_datetime - character(len=*), parameter :: expected = '2022-08-26 07:30:37' - integer, parameter :: yy = 2022 - integer, parameter :: mm = 08 - integer, parameter :: dd = 26 - integer, parameter :: h = 07 - integer, parameter :: m = 30 - integer, parameter :: s = 37 - character(len=:), allocatable :: actual - integer :: status, rc - - call ESMF_TimeSet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - call convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, actual, _RC) - @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) - end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString +! @Test +! subroutine test_make_NetCDF_DateTime_units_string() +! type(ESMF_Time) :: start_time +! character(len=*), parameter :: tunit = 'seconds' +! character(len=*), parameter :: expected = tunit // ' since 2012-08-26 08:36:37' +! character(len=:), allocatable :: actual +! integer :: status +! +! call ESMF_TimeSet(start_time, yy=2012, mm=08, dd=26, h=08, m=36, s=37, rc=status) +! @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') +! call make_NetCDF_DateTime_units_string(start_time, tunit, actual, rc=status) +! @assertTrue(status == SUCCESS, 'Failed to make units_string') +! @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) +! end subroutine test_make_NetCDF_DateTime_units_string + +! @Test +! subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() +! type(ESMF_Time) :: esmf_datetime +! character(len=*), parameter :: expected = '2022-08-26 07:30:37' +! integer, parameter :: yy = 2022 +! integer, parameter :: mm = 08 +! integer, parameter :: dd = 26 +! integer, parameter :: h = 07 +! integer, parameter :: m = 30 +! integer, parameter :: s = 37 +! character(len=:), allocatable :: actual +! integer :: status, rc +! +! call ESMF_TimeSet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) +! call convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, actual, _RC) +! @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) +! end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString @Test subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() @@ -280,22 +280,22 @@ contains end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time - @Test - subroutine test_is_time_unit() - - @assertTrue(is_time_unit('years')) - @assertTrue(is_time_unit('months')) - @assertTrue(is_time_unit('days')) - @assertTrue(is_time_unit('hours')) - @assertTrue(is_time_unit('minutes')) - @assertTrue(is_time_unit('seconds')) - @assertTrue(is_time_unit('milliseconds')) - @assertTrue(is_time_unit(' milliseconds ')) - - @assertFalse(is_time_unit('nanoseconds')) - @assertFalse(is_time_unit('year')) - - end subroutine test_is_time_unit +! @Test +! subroutine test_is_time_unit() +! +! @assertTrue(is_time_unit('years')) +! @assertTrue(is_time_unit('months')) +! @assertTrue(is_time_unit('days')) +! @assertTrue(is_time_unit('hours')) +! @assertTrue(is_time_unit('minutes')) +! @assertTrue(is_time_unit('seconds')) +! @assertTrue(is_time_unit('milliseconds')) +! @assertTrue(is_time_unit(' milliseconds ')) +! +! @assertFalse(is_time_unit('nanoseconds')) +! @assertFalse(is_time_unit('year')) +! +! end subroutine test_is_time_unit @test subroutine test_get_shift_sign() @@ -405,7 +405,7 @@ contains end subroutine test_convert_to_integer @test - subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer() + subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer() integer :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units @@ -431,12 +431,12 @@ contains call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') - call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') - end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_integer + end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer @test subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() @@ -472,7 +472,7 @@ contains end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer @test - subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real() + subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real() real(kind=ESMF_KIND_R8) :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units @@ -497,15 +497,13 @@ contains call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') - call ESMF_TimePrint(esmf_time, options='string', rc = status) !wdb fixme deleteme - call convert_NetCDF_DateTime_to_ESMF_Time(duration, units_string, time, rc = status) + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') - call ESMF_TimePrint(time, options='string', rc = status) !wdb fixme deleteme @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') - end subroutine test_convert_NetCDF_DateTime_to_ESMF_Time_real + end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real @test subroutine test_make_ESMF_TimeInterval_real() From edfa9b07d4ea6b923b16ec7a9fbd70ced60b706b Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 1 Jun 2023 18:37:02 -0400 Subject: [PATCH 05/32] Comment out public access for old procedures --- base/MAPL_NetCDF.F90 | 104 ++++++++++++++----------------------------- 1 file changed, 34 insertions(+), 70 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 74664ff3e1ac..ca5f0fd9344c 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -24,26 +24,30 @@ module MAPL_NetCDF implicit none - public :: convert_NetCDF_DateTime_to_ESMF - public :: convert_ESMF_to_NetCDF_DateTime - public :: convert_NetCDF_DateTime_to_ESMF_Time + public :: get_NetCDF_duration_from_ESMF_Time + public :: get_ESMF_Time_from_NetCDF_DateTime + + ! OLD HIGH-LEVEL +! public :: convert_NetCDF_DateTime_to_ESMF +! public :: convert_ESMF_to_NetCDF_DateTime + + ! LOW-LEVEL public :: make_ESMF_TimeInterval public :: make_NetCDF_DateTime_duration - public :: make_NetCDF_DateTime_units_string - public :: convert_ESMF_Time_to_NetCDF_DateTimeString +! public :: make_NetCDF_DateTime_units_string +! public :: convert_ESMF_Time_to_NetCDF_DateTimeString public :: convert_to_integer public :: convert_NetCDF_DateTimeString_to_ESMF_Time - public :: is_time_unit +! public :: is_time_unit public :: is_valid_netcdf_datetime_string public :: get_shift_sign public :: split public :: split_all - public :: get_NetCDF_duration_from_ESMF_Time - interface convert_NetCDF_DateTime_to_ESMF_Time - module procedure :: convert_NetCDF_DateTime_to_ESMF_Time_integer - module procedure :: convert_NetCDF_DateTime_to_ESMF_Time_real - end interface convert_NetCDF_DateTime_to_ESMF_Time + interface get_ESMF_Time_from_NetCDF_DateTime + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real + end interface get_ESMF_Time_from_NetCDF_DateTime interface make_ESMF_TimeInterval module procedure :: make_ESMF_TimeInterval_integer @@ -65,9 +69,9 @@ module MAPL_NetCDF end interface split interface split_all - module procedure :: split_all_recursive module procedure :: split_all_iterative end interface split_all + private character, parameter :: PART_DELIM = ' ' @@ -95,6 +99,7 @@ module MAPL_NetCDF ! Convert NetCDF_DateTime {int_time, units_string} to ! ESMF time variables {interval, start_time, time} and time unit {tunit} ! start_time is the start time, and time is start_time + interval + ! OLD subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & interval, start_time, unusable, time, tunit, rc) integer, intent(in) :: int_time @@ -146,6 +151,7 @@ subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & end subroutine convert_NetCDF_DateTime_to_ESMF ! Convert ESMF time variables to an NetCDF datetime + ! OLD subroutine convert_ESMF_to_NetCDF_DateTime(tunit, start_time, int_time, units_string, unusable, time, interval, rc) character(len=*), intent(in) :: tunit type(ESMF_Time), intent(inout) :: start_time @@ -180,6 +186,7 @@ end subroutine convert_ESMF_to_NetCDF_DateTime !========================= OLD LOWER-LEVEL PROCEDURES ========================== ! Make 'units' for NetCDF datetime + ! OLD subroutine make_NetCDF_DateTime_units_string(start_time, tunit, units_string, unusable, rc) type(ESMF_Time), intent(inout) :: start_time character(len=*), intent(in) :: tunit @@ -201,6 +208,7 @@ subroutine make_NetCDF_DateTime_units_string(start_time, tunit, units_string, un end subroutine make_NetCDF_DateTime_units_string ! Convert ESMF_Time to a NetCDF datetime string (start datetime) + ! OLD subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_string, unusable, rc) type(ESMF_Time), intent(inout) :: esmf_datetime character(len=:), allocatable, intent(out) :: datetime_string @@ -293,6 +301,7 @@ subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, durati end subroutine get_NetCDF_duration_from_ESMF_Time_integer + ! Get NetCDF DateTime duration from ESMF_Time and units_string (real) subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, unusable, rc) type(ESMF_Time), intent(inout) :: time character(len=:), allocatable, intent(in) :: units_string @@ -334,7 +343,9 @@ subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, end subroutine get_NetCDF_duration_from_ESMF_Time_real - subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & + ! Convert NetCDF datetime {units_string, duration (integer)} + ! into an ESMF_Time value representing the same datetime + subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, & units_string, time, unusable, rc) integer, intent(in) :: duration character(len=*), intent(in) :: units_string @@ -378,9 +389,11 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(duration, & _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer + end subroutine get_ESMF_Time_from_NetCDF_DateTime_integer - subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & + ! Convert NetCDF datetime {units_string, duration (real)} + ! into an ESMF_Time value representing the same datetime + subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, & units_string, time, unusable, rc) real(kind=ESMF_KIND_R8), intent(in) :: duration character(len=*), intent(in) :: units_string @@ -395,7 +408,7 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & character(len=:), allocatable :: preposition character(len=:), allocatable :: date_string character(len=:), allocatable :: time_string - character(len=:), allocatable :: datetime_string !wdb fixme deleteme + character(len=:), allocatable :: datetime_string real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor integer :: status @@ -408,33 +421,23 @@ subroutine convert_NetCDF_DateTime_to_ESMF_Time_real(duration, & _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') units = adjustl(parts(1)) - print *, 'units: ', units !wdb fixme deleteme preposition = adjustl(parts(2)) - print *, 'preposition: ', preposition !wdb fixme deleteme date_string = adjustl(parts(3)) - print *, 'date_string: ', date_string !wdb fixme deleteme time_string = adjustl(parts(4)) - print *, 'time_string: ', time_string !wdb fixme deleteme + datetime_string = date_string // PART_DELIM // time_string sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - print *, 'sign_factor = ', sign_factor !wdb fixme deleteme signed_duration = sign_factor * duration - print *, 'signed_duration = ', signed_duration - datetime_string = date_string // PART_DELIM // time_string !wdb fixme deleteme - print *, 'datetime string: ' // datetime_string !wdb fixme deleteme -! call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) - call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) !wdb fixme deleteme - call ESMF_TimePrint(start_time, options='string', _RC) !wdb fixme deleteme + + call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) - call ESMF_TimeIntervalPrint(interval, options='string', _RC) !wdb fixme deleteme time = start_time + interval - call ESMF_TimePrint(time, options='string', _RC) !wdb fixme deleteme _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTime_to_ESMF_Time_real + end subroutine get_ESMF_Time_from_NetCDF_DateTime_real !======================= END NEW HIGH-LEVEL PROCEDURES ========================= !=============================================================================== @@ -542,10 +545,8 @@ subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusab select case(trim(adjustl(tunit))) case('years') _FAIL('Real values for years are not supported.') -! call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) case('months') _FAIL('Real values for months are not supported.') -! call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) case('days') _FAIL('Real values for days are not supported.') case('hours') @@ -658,6 +659,7 @@ function is_valid_netcdf_datetime_string(string) result(tval) end function is_valid_netcdf_datetime_string + ! OLD function is_time_unit(tunit) character(len=*), intent(in) :: tunit logical :: is_time_unit @@ -723,44 +725,6 @@ function split_all_iterative(string, delimiter) result(parts) end function split_all_iterative - ! Split string into all substrings based on delimiter - function split_all_recursive(string, delimiter, recurse) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - logical , intent(in) :: recurse - character(len=:), allocatable :: parts(:) - - if(recurse) then - parts = splitter(trim(string), delimiter) - return - end if - - parts = split_all_iterative(string, delimiter) - contains - - recursive function splitter(string, delimiter) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=:), allocatable :: parts(:) - character(len=:), allocatable :: head - character(len=:), allocatable :: tail(:) - integer :: next, last - - last = index(string, delimiter) - 1 - - if(last < 0) then - parts = [string] - else - head = string(1:last) - next = last + len(delimiter) + 1 - tail = splitter(string(next:len(string)), delimiter) - parts = [head, tail] - end if - - end function splitter - - end function split_all_recursive - ! Convert string representing an integer to the integer subroutine convert_to_integer(string_in, int_out, rc) character(len=*), intent(in) :: string_in From 296638b4fa603f5fcfa454978074bf4cef58133b Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 5 Jun 2023 14:41:57 -0400 Subject: [PATCH 06/32] All test succeed --- base/MAPL_NetCDF.F90 | 184 ++++++++++++++++++++++++++------- base/tests/test_MAPL_NetCDF.pf | 173 ++++++++++++++++++------------- 2 files changed, 245 insertions(+), 112 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index ca5f0fd9344c..227d45f531fa 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -15,6 +15,13 @@ ! NetCDF datetime is: {integer, character(len=*)} ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} + +#ifdef NEGATIVE_STRING +# undef NEGATIVE_STRING +#endif + +#define NEGATIVE_STRING(S) S(1:1) == '-' + module MAPL_NetCDF use MAPL_ExceptionHandling @@ -43,6 +50,8 @@ module MAPL_NetCDF public :: get_shift_sign public :: split public :: split_all + public :: is_digit_string + public :: convert_to_real interface get_ESMF_Time_from_NetCDF_DateTime module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer @@ -78,6 +87,7 @@ module MAPL_NetCDF character, parameter :: ISO_DELIM = 'T' character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' + character, parameter :: POINT = '.' character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' character(len=*), parameter :: NETCDF_DATETIME = NETCDF_DATE // PART_DELIM // NETCDF_TIME @@ -90,6 +100,12 @@ module MAPL_NetCDF 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] character, parameter :: SPACE = ' ' type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN + character(len=*), parameter :: DIGIT_CHARS = '0123456789' + character, parameter :: PLUS = '+' + character, parameter :: MINUS = '-' + character(len=*), parameter :: SIGNS = PLUS // MINUS + character(len=*), parameter :: EMPTY_STRING = '' + contains @@ -444,7 +460,7 @@ end subroutine get_ESMF_Time_from_NetCDF_DateTime_real !========================= NEW LOWER-LEVEL PROCEDURES ========================== ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) + subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, datetime, unusable, rc) character(len=*), intent(in) :: datetime_string type(ESMF_Time), intent(inout) :: datetime class (KeywordEnforcer), optional, intent(in) :: unusable @@ -498,6 +514,78 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, _RETURN(_SUCCESS) + end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior + + ! Convert NetCDF datetime to ESMF_Time + subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) + character(len=*), intent(in) :: datetime_string + type(ESMF_Time), intent(inout) :: datetime + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + integer :: yy, mm, dd, h, m, s + real(kind=ESMF_KIND_R8) :: s_r8 + character(len=:), allocatable :: part(:) + character(len=:), allocatable :: date_string + character(len=:), allocatable :: time_string + + _UNUSED_DUMMY(unusable) + + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), & + 'Invalid datetime string: ' // datetime_string) + + part = split_all(datetime_string, PART_DELIM) + date_string = part(1) + time_string = part(2) + + ! convert first 3 substrings to year, month, day + part = split_all(date_string, DATE_DELIM) + + call convert_to_integer(part(1), yy, rc = status) + _ASSERT(status == 0, 'Unable to convert year string') + + call convert_to_integer(part(2), mm, rc = status) + _ASSERT(status == 0, 'Unable to convert month string') + + call convert_to_integer(part(3), dd, rc = status) + _ASSERT(status == 0, 'Unable to convert day string') + + ! convert second 3 substrings to hour, minute, second + part = split_all(time_string, TIME_DELIM) + + call convert_to_integer(part(1), h, rc = status) + _ASSERT(status == 0, 'Unable to convert hour string') + + call convert_to_integer(part(2), m, rc = status) + _ASSERT(status == 0, 'Unable to convert minute string') + + ! no need to call this unless larger time units are correct + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) + + ! Need to see if the seconds portion has fractional portion and handle it. + ! Split seconds string to see if it has a fractional part. + select case(size(split_all(part(3), POINT))) + + ! no fractional portion => use integer + case(1) + call convert_to_integer(part(3), s, rc = status) + _ASSERT(status == 0, 'Unable to convert second string') + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + + ! fractional portion => use real(kind=ESMF_KIND_R8) + case(2) + call convert_to_real(part(3), s_r8, rc = status) + _ASSERT(status == 0, 'Unable to convert second string') + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) + + ! wrong number of substrings => FAIL + case default + _FAIL('Incorrect number of second parts') + + end select + + _RETURN(_SUCCESS) + end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time ! Make ESMF_TimeInterval from a span of time, time unit, and start time @@ -637,28 +725,46 @@ end subroutine make_NetCDF_DateTime_duration_real !=============================================================================== !============================= UTILITY PROCEDURES ============================== - function is_valid_netcdf_datetime_string(string) result(tval) - character(len=*), parameter :: DIGITS = '0123456789' + recursive function is_valid_netcdf_datetime_string(string) result(lval) character(len=*), intent(in) :: string - logical :: tval + logical :: lval integer :: i - tval = .false. + lval = .false. + + i = index(string, POINT) + + if(i == 1) return + + if(i > 0) then + lval = is_valid_netcdf_datetime_string_real_seconds(string, i) + return + end if if(len(trim(string)) /= len(NETCDF_DATETIME)) return do i=1, len_trim(string) - if(scan(NETCDF_DATETIME(i:i), DIGITS) > 0) then - if(scan(string(i:i), DIGITS) <= 0) return + if(scan(NETCDF_DATETIME(i:i), DIGIT_CHARS) > 0) then + if(scan(string(i:i), DIGIT_CHARS) <= 0) return else if(string(i:i) /= NETCDF_DATETIME(i:i)) return end if end do - tval = .true. + lval = .true. end function is_valid_netcdf_datetime_string + function is_valid_netcdf_datetime_string_real_seconds(string, i) result(lval) + character(len=*), intent(in) :: string + integer, intent(in) :: i + logical :: lval + + lval = is_valid_netcdf_datetime_string(string(1:(i-1))) .and. & + ((i == len(string)) .or. is_digit_string(string((i+1):))) + + end function is_valid_netcdf_datetime_string_real_seconds + ! OLD function is_time_unit(tunit) character(len=*), intent(in) :: tunit @@ -726,46 +832,46 @@ function split_all_iterative(string, delimiter) result(parts) end function split_all_iterative ! Convert string representing an integer to the integer - subroutine convert_to_integer(string_in, int_out, rc) - character(len=*), intent(in) :: string_in - integer, intent(out) :: int_out + subroutine convert_to_integer(string, n, rc) + character(len=*), intent(in) :: string + integer, intent(out) :: n integer, optional, intent(out) :: rc integer :: stat - read(string_in, '(I16)', iostat=stat) int_out + n = -1 + read(string, '(I16)', iostat=stat) n if(present(rc)) rc = stat end subroutine convert_to_integer + ! Convert string representing a real to a real(REAL64) + subroutine convert_to_real(string, t, rc) + character(len=*), intent(in) :: string + real(kind=ESMF_KIND_R8), intent(out) :: t + integer, optional, intent(out) :: rc + integer :: stat + + t = -1 + print *, 'string: ', string !wdb fixme deleteme + read(string, *, iostat=stat) t + + if(present(rc)) rc = stat + + end subroutine convert_to_real + + function is_digit_string(string) + character(len=*), intent(in) :: string + logical :: is_digit_string + + is_digit_string = .FALSE. + if(len_trim(string) == 0) return + + is_digit_string = (verify(string(:len_trim(string)), DIGIT_CHARS) == 0) + + end function is_digit_string + !=========================== END UTILITY PROCEDURES ============================ !=============================================================================== end module MAPL_NetCDF -! function split_chararray(chararray, delimiter) result(parts) -! character(len=*), intent(in) :: chararray(:) -! character(len=*), intent(in) :: delimiter -! character(len=:), allocatable :: parts(:) -! -! if(size(chararray) == 0) then -! parts = chararray -! return -! end if -! -! parts = strip_empty([chararray(1:size(chararray)), split(chararray(size(chararray)), delimiter)]) -! -! end function split_chararray -! -! function strip_empty(chararray) result(stripped) -! character(len=*), intent(in) :: chararray -! character(len=:), allocatable:: stripped -! integer :: i -! -! stripped = [character::] -! -! do i = 1, size(chararray) -! if(len(chararray(i) > 0)) stripped = [stripped, chararray(i)] -! end do -! -! end function strip_empty - diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 940b91bda387..fcc7e0a1a16e 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -51,13 +51,13 @@ contains end function make_units_string - logical function qequal(na, nb) + logical function rational_equals(na, nb) integer, intent(in) :: na(2) integer, intent(in) :: nb(2) - qequal = ( na(1) * nb(2) == na(2) * nb(1) ) + rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) - end function qequal + end function rational_equals logical function ESMF_Times_Equal(timeu, timev) type(ESMF_Time), intent(in) :: timeu, timev @@ -70,7 +70,7 @@ contains ESMF_Times_Equal = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & .and. (uh == vh) .and. (um == vm) .and. (us == vs) & - .and. qequal([usN, usD], [vsN, vsD]) ) + .and. rational_equals([usN, usD], [vsN, vsD]) ) end function ESMF_Times_Equal @@ -402,6 +402,23 @@ contains @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + expected = -2023 + str = '-2023' + call convert_to_integer(str, actual, rc = status) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + + expected = 0 + str = '0' + call convert_to_integer(str, actual, rc = status) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + + expected = 0 + str = '0.0' + call convert_to_integer(str, actual, rc = status) + @assertTrue(.not. status == SUCCESS, str // ' should not convert.') + end subroutine test_convert_to_integer @test @@ -573,73 +590,83 @@ contains end subroutine test_get_NetCDF_duration_from_ESMF_Time_real + @test + subroutine test_is_digit_string() + character(len=:), allocatable :: test_string + + test_string = '1' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = '9362754810' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = '125 ' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = 'ADFG' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '1ADFG' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '1213A' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = ' 1213' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = ' ' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '%^*' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '9%^*7' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + end subroutine test_is_digit_string + + @test + subroutine test_convert_to_real() + character(len=:), allocatable :: str + real(kind=ESMF_KIND_R8) :: expected, actual + real(kind=ESMF_KIND_R8), parameter :: RELATIVE_TOLERANCE = 1D-08 + real(kind=ESMF_KIND_R8) :: tolerance + integer :: status + + expected = 6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '6.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = -6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '-6.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 2023 + tolerance = expected * RELATIVE_TOLERANCE + str = '2023' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 0.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '0.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 0.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = 'asdf6.015625' + call convert_to_real(str, actual, rc = status) + @assertTrue(.not. status == SUCCESS, str // ' should not convert.') + + end subroutine test_convert_to_real + end module test_MAPL_NetCDF -! @test -! subroutine test_split_chararray() -! character(len=*), parameter :: head = 'head' -! character(len=*), parameter :: tail = 'tail' -! character(len=*), parameter :: delim = '::' -! character(len=:), allocatable :: parts(:) -! -! parts = [character::] -! parts = split(parts, delimiter) -! @assertEqual(0, size(parts)) -! -! parts = [ head // delim // tail ] -! parts = split(parts, delim) -! @assertEqual(2, size(parts)) -! @assertEqual(head, parts(1), 'Part 1 does not match head.') -! @assertEqual(tail, parts(2), 'Part 2 does not match tail.') -! -! parts = [ delim // tail ] -! parts = split(parts, delim) -! @assertEqual(1, size(parts)) -! @assertEqual(tail, parts(1), 'Part 1 does not match tail.') -! -! parts = [ head // delim ] -! parts = split(parts, delim) -! @assertEqual(1, size(parts)) -! @assertEqual(head, parts(1), 'Part 1 does not match head.') -! end subroutine test_split_chararray -! -! @test -! subroutine test_strip_empty() -! character(len=:), allocatable :: chararray -! character(len=*), parameter :: ALL_CHARS = [ 'AAA', 'BBB', 'CCC' ] -! integer :: i, missing -! -! charray = ALL_CHARS -! charray = strip_empty(chararray) -! @assertEqual(size(ALL_CHARS), size(chararray), 'Number of elements do not match.') -! do i = 1, size(charray) -! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') -! end do -! -! charray = [ALL_CHARS(1), ALL_CHARS(2), ''] -! missing = 3 -! charray = strip_empty(chararray) -! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') -! do i = 1, size(charray) -! if(i == missing) cycle -! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') -! end do -! -! charray = ['', ALL_CHARS(2), ALL_CHARS(3)] -! missing = 1 -! charray = strip_empty(chararray) -! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') -! do i = 1, size(charray) -! if(i == missing) cycle -! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') -! end do -! -! charray = [ALL_CHARS(1), '', ALL_CHARS(3)] -! missing = 2 -! charray = strip_empty(chararray) -! @assertEqual(size(ALL_CHARS)-1, size(chararray), 'Number of elements do not match.') -! do i = 1, size(charray) -! if(i == missing) cycle -! @assertEqual(ALL_CHARS(i), chararray(i), 'Elements do not match.') -! end do -! -! end subroutine test_strip_empty From 455052853260330cfe7607bd6db23f31c9347e3a Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 6 Jun 2023 15:38:31 -0400 Subject: [PATCH 07/32] Implemented updated public subroutines including support for real values --- base/MAPL_NetCDF.F90 | 233 +--------- base/tests/CMakeLists.txt | 5 + base/tests/test_MAPL_NetCDF.pf | 590 ++---------------------- base/tests/test_MAPL_NetCDF_helpers.F90 | 67 +++ base/tests/test_MAPL_NetCDF_private.pf | 371 +++++++++++++++ 5 files changed, 496 insertions(+), 770 deletions(-) create mode 100644 base/tests/test_MAPL_NetCDF_helpers.F90 create mode 100644 base/tests/test_MAPL_NetCDF_private.pf diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 227d45f531fa..f0488fad827b 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -1,27 +1,10 @@ -!wdb todo -! todo Switch integer to integer(kind=ESMF_KIND_I8) where appropriate. -!Do REAL(8) days need to be included? -!Do INTEGER or INTEGER(8) days need to be included? -!Is d_r8 Julian day or Gregorian day? -!Does get_shift_sign need to be converted to real for real procedures? - -!subroutine to convert -!From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] -!To: !ESMF_TIME: with gregorian calendar -!And vice versa. #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" -! Procedures to convert from NetCDF datetime to ESMF_Time and ESMF_TimeInterval +! Procedures to convert between NetCDF datetime and ESMF_Time ! NetCDF datetime is: {integer, character(len=*)} ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} -#ifdef NEGATIVE_STRING -# undef NEGATIVE_STRING -#endif - -#define NEGATIVE_STRING(S) S(1:1) == '-' - module MAPL_NetCDF use MAPL_ExceptionHandling @@ -34,30 +17,22 @@ module MAPL_NetCDF public :: get_NetCDF_duration_from_ESMF_Time public :: get_ESMF_Time_from_NetCDF_DateTime - ! OLD HIGH-LEVEL -! public :: convert_NetCDF_DateTime_to_ESMF -! public :: convert_ESMF_to_NetCDF_DateTime - - ! LOW-LEVEL - public :: make_ESMF_TimeInterval - public :: make_NetCDF_DateTime_duration -! public :: make_NetCDF_DateTime_units_string -! public :: convert_ESMF_Time_to_NetCDF_DateTimeString - public :: convert_to_integer - public :: convert_NetCDF_DateTimeString_to_ESMF_Time -! public :: is_time_unit - public :: is_valid_netcdf_datetime_string - public :: get_shift_sign - public :: split - public :: split_all - public :: is_digit_string - public :: convert_to_real + interface get_NetCDF_duration_from_ESMF_Time + module procedure :: get_NetCDF_duration_from_ESMF_Time_integer + module procedure :: get_NetCDF_duration_from_ESMF_Time_real + end interface get_NetCDF_duration_from_ESMF_Time interface get_ESMF_Time_from_NetCDF_DateTime module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real end interface get_ESMF_Time_from_NetCDF_DateTime + private + + ! LOW-LEVEL +! public :: convert_NetCDF_DateTimeString_to_ESMF_Time, make_NetCDF_DateTime_duration, is_digit_string, get_shift_sign +! public :: make_ESMF_TimeInterval, is_valid_netcdf_datetime_string, convert_to_integer, convert_to_real, split, split_all + interface make_ESMF_TimeInterval module procedure :: make_ESMF_TimeInterval_integer module procedure :: make_ESMF_TimeInterval_real @@ -68,11 +43,6 @@ module MAPL_NetCDF module procedure :: make_NetCDF_DateTime_duration_real end interface make_NetCDF_DateTime_duration - interface get_NetCDF_duration_from_ESMF_Time - module procedure :: get_NetCDF_duration_from_ESMF_Time_integer - module procedure :: get_NetCDF_duration_from_ESMF_Time_real - end interface get_NetCDF_duration_from_ESMF_Time - interface split module procedure :: split_chars end interface split @@ -81,7 +51,6 @@ module MAPL_NetCDF module procedure :: split_all_iterative end interface split_all - private character, parameter :: PART_DELIM = ' ' character, parameter :: ISO_DELIM = 'T' @@ -105,173 +74,9 @@ module MAPL_NetCDF character, parameter :: MINUS = '-' character(len=*), parameter :: SIGNS = PLUS // MINUS character(len=*), parameter :: EMPTY_STRING = '' - contains -!=============================================================================== -!========================= OLD HIGH-LEVEL PROCEDURES =========================== - - ! Convert NetCDF_DateTime {int_time, units_string} to - ! ESMF time variables {interval, start_time, time} and time unit {tunit} - ! start_time is the start time, and time is start_time + interval - ! OLD - subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & - interval, start_time, unusable, time, tunit, rc) - integer, intent(in) :: int_time - character(len=*), intent(in) :: units_string - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: start_time - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: time - character(len=:), allocatable, optional, intent(out) :: tunit - integer, optional, intent(out) :: rc - character(len=:), allocatable :: tunit_ - character(len=len_trim(units_string)) :: parts(2) - character(len=len_trim(units_string)) :: head - character(len=len_trim(units_string)) :: tail - - integer :: span, factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(int_time >= 0, 'Negative span not supported') - _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - - ! get time unit, tunit - parts = split(trim(adjustl(units_string)), PART_DELIM) - head = parts(1) - tail = parts(2) - tunit_ = trim(adjustl(head)) - _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') - if(present(tunit)) tunit = tunit_ - - ! get span - parts = split(trim(adjustl(tail)), PART_DELIM) - head = parts(1) - tail = parts(2) - - factor = get_shift_sign(head) - _ASSERT(factor /= 0, 'Unrecognized preposition') - span = factor * int_time - - call convert_NetCDF_DateTimeString_to_ESMF_Time(trim(adjustl(tail)), start_time, _RC) - call make_ESMF_TimeInterval(span, tunit_, start_time, interval, _RC) - - ! get time - if(present(time)) time = start_time + interval - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTime_to_ESMF - - ! Convert ESMF time variables to an NetCDF datetime - ! OLD - subroutine convert_ESMF_to_NetCDF_DateTime(tunit, start_time, int_time, units_string, unusable, time, interval, rc) - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: start_time - integer, intent(out) :: int_time - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: time - type(ESMF_TimeInterval), optional, intent(inout) :: interval - integer, optional, intent(out) :: rc - type(ESMF_TimeInterval) :: interval_ - integer :: status - - _UNUSED_DUMMY(unusable) - - if(present(interval)) then - interval_ = interval - elseif(present(time)) then - interval_ = time - start_time - else - _FAIL( 'Only one input argument present') - end if - - call make_NetCDF_DateTime_duration(interval_, start_time, tunit, int_time, _RC) - call make_NetCDF_DateTime_units_string(start_time, tunit, units_string, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_to_NetCDF_DateTime - -!========================= END OLD HIGH-LEVEL PROCEDURES ======================= -!=============================================================================== -!========================= OLD LOWER-LEVEL PROCEDURES ========================== - - ! Make 'units' for NetCDF datetime - ! OLD - subroutine make_NetCDF_DateTime_units_string(start_time, tunit, units_string, unusable, rc) - type(ESMF_Time), intent(inout) :: start_time - character(len=*), intent(in) :: tunit - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - character(len=*), parameter :: preposition = 'since' - character(len=:), allocatable :: datetime_string - integer :: status - - _UNUSED_DUMMY(unusable) - - ! make units_string - call convert_ESMF_Time_to_NetCDF_DateTimeString(start_time, datetime_string, _RC) - units_string = tunit //SPACE// preposition //SPACE// datetime_string - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_units_string - - ! Convert ESMF_Time to a NetCDF datetime string (start datetime) - ! OLD - subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_string, unusable, rc) - type(ESMF_Time), intent(inout) :: esmf_datetime - character(len=:), allocatable, intent(out) :: datetime_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - character(len=*), parameter :: ERR_PRE = 'Failed to write string: ' - integer :: yy, mm, dd, h, m, s - character(len=10) :: FMT - character(len=4) :: yy_string - character(len=2) :: mm_string - character(len=2) :: dd_string - character(len=2) :: h_string - character(len=2) :: m_string - character(len=2) :: s_string - character(len=LEN_DATETIME) :: tmp_string - integer :: status, iostatus - - _UNUSED_DUMMY(unusable) - - call ESMF_TimeGet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - FMT='(BZ, I2.2)' - write(s_string, fmt=FMT, iostat=iostatus) s - _ASSERT(iostatus == 0, ERR_PRE // 'second') - write(m_string, fmt=FMT, iostat=iostatus) m - _ASSERT(iostatus == 0, ERR_PRE // 'minute') - write(h_string, fmt=FMT, iostat=iostatus) h - _ASSERT(iostatus == 0, ERR_PRE // 'hour') - write(dd_string, fmt=FMT, iostat=iostatus) dd - _ASSERT(iostatus == 0, ERR_PRE // 'day') - write(mm_string, fmt=FMT, iostat=iostatus) mm - _ASSERT(iostatus == 0, ERR_PRE // 'month') - FMT='(BZ, I4.4)' - write(yy_string, fmt=FMT, iostat=iostatus) yy - _ASSERT(iostatus == 0, ERR_PRE // 'year') - - tmp_string = yy_string // DATE_DELIM // mm_string // DATE_DELIM // dd_string // PART_DELIM // & - h_string // TIME_DELIM // m_string // TIME_DELIM // s_string - - datetime_string = tmp_string - - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString - -!======================= END OLD LOWER-LEVEL PROCEDURES ======================== !=============================================================================== !========================= NEW HIGH-LEVEL PROCEDURES =========================== @@ -765,20 +570,6 @@ function is_valid_netcdf_datetime_string_real_seconds(string, i) result(lval) end function is_valid_netcdf_datetime_string_real_seconds - ! OLD - function is_time_unit(tunit) - character(len=*), intent(in) :: tunit - logical :: is_time_unit - integer :: i - - is_time_unit = .TRUE. - do i = 1, size(TIME_UNITS) - if(adjustl(tunit) == adjustl(TIME_UNITS(i))) return - end do - is_time_unit = .FALSE. - - end function is_time_unit - ! Get the sign of integer represening a time span based on preposition function get_shift_sign(preposition) character(len=*), intent(in) :: preposition @@ -853,13 +644,13 @@ subroutine convert_to_real(string, t, rc) integer :: stat t = -1 - print *, 'string: ', string !wdb fixme deleteme read(string, *, iostat=stat) t if(present(rc)) rc = stat end subroutine convert_to_real + ! Check if string consists of only digit characters function is_digit_string(string) character(len=*), intent(in) :: string logical :: is_digit_string diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 5d7469ce6716..29592dc994b8 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -1,6 +1,9 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.base/tests") add_definitions(-DUSE_MPI) +# uncomment test_mapl_netcdf_private.pf to test private MAPL_NetCDF procedures +# as well as the helper procedures used by test_MAPL_NetCDF and test_MAPL_NetCDF_private +# make sure to make the private procedures in MAPL_NetCDF public (uncomment the 'public' statements). set (TEST_SRCS test_Mapl_Base.pf test_sort.pf @@ -15,6 +18,8 @@ set (TEST_SRCS test_DirPath.pf test_TimeStringConversion.pf test_MAPL_NetCDF.pf + test_MAPL_NetCDF_helpers.F90 +# test_MAPL_NetCDF_private.pf # test_MAPL_ISO8601_DateTime_ESMF.pf ) diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index fcc7e0a1a16e..84d4603bb859 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -1,6 +1,11 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" +!=============================================================================== +! TEST_MAPL_NETCDF +!=============================================================================== module test_MAPL_NetCDF + + use test_MAPL_NetCDF_helpers use MAPL_ExceptionHandling use MAPL_NetCDF use ESMF @@ -9,10 +14,8 @@ module test_MAPL_NetCDF implicit none type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG_DEF = ESMF_CALKIND_GREGORIAN - integer, parameter :: SUCCESS = 0 - integer, parameter :: SECONDS_PER_MINUTE = 60 - + contains @Before @@ -24,411 +27,14 @@ contains end subroutine set_up - function make_datetime_string(yy, mm, dd, h, m, s) result(datetime_string) - integer, intent(in) :: yy, mm, dd, h, m, s - character(len=32) :: datetime_string - character(len=*), parameter :: fmt_string = '(I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' - integer :: iostat_ - - write(datetime_string, fmt=fmt_string, iostat=iostat_) yy, mm, dd, h, m, s - if(iostat_ == SUCCESS) return - datetime_string = '' - - end function make_datetime_string - - function make_units_string(units, preposition, yy, mm, dd, h, m, s) result(units_string) - character(len=*), intent(in) :: units - character(len=*), intent(in) :: preposition - integer, intent(in) :: yy, mm, dd, h, m, s - character(len=132) :: units_string - character(len=:), allocatable :: datetime_string - character(len=*), parameter :: SPACE = ' ' - - units_string = '' - datetime_string = make_datetime_string(yy, mm, dd, h, m, s) - if(len_trim(datetime_string) == 0) return - units_string = trim(units) // SPACE // trim(preposition) // SPACE // datetime_string - - end function make_units_string - - logical function rational_equals(na, nb) - integer, intent(in) :: na(2) - integer, intent(in) :: nb(2) - - rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) - - end function rational_equals - - logical function ESMF_Times_Equal(timeu, timev) - type(ESMF_Time), intent(in) :: timeu, timev - integer :: uyy, umm, udd, uh, um, us, usN, usD - integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD - integer :: status - - call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) - call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) - - ESMF_Times_Equal = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & - .and. (uh == vh) .and. (um == vm) .and. (us == vs) & - .and. rational_equals([usN, usD], [vsN, vsD]) ) - - end function ESMF_Times_Equal - - @Test - subroutine test_ESMF_Times_Equal() - integer :: yy = 1957 - integer :: mm = 10 - integer :: dd = 19 - integer :: h = 18 - integer :: m = 37 - integer :: s = 53 - type(ESMF_Time) :: timea, timeb - integer :: status - - call ESMF_TimeSet(timea, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create timea') - call ESMF_TimeSet(timeb, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create timeb') - @assertTrue(timea == timeb, 'ESMF_Time values are not equal.') - @assertTrue(ESMF_Times_Equal(timea, timeb), 'ESMF_Time values do not match.') - - end subroutine test_ESMF_Times_Equal - - @Test - subroutine test_make_datetime_string() - integer, parameter :: YY = 1999 - integer, parameter :: MM = 12 - integer, parameter :: DD = 31 - integer, parameter :: H = 23 - integer, parameter :: M = 59 - integer, parameter :: S = 59 - - character(len=*), parameter :: EXPECTED_DATETIME_STRING = '1999-12-31 23:59:59' - integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_DATETIME_STRING) - - character(len=:), allocatable :: actual_datetime_string - - actual_datetime_string = make_datetime_string(yy, mm, dd, h, m, s) - @assertEqual(EXPECTED_LENGTH, len_trim(actual_datetime_string), 'Incorrect length for datetime string') - @assertEqual(EXPECTED_DATETIME_STRING, trim(actual_datetime_string), 'Datetime strings do not match.') - - end subroutine test_make_datetime_string - - @Test - subroutine test_make_units_string() - integer, parameter :: YY = 1999 - integer, parameter :: MM = 12 - integer, parameter :: DD = 31 - integer, parameter :: H = 23 - integer, parameter :: M = 59 - integer, parameter :: S = 59 - - character(len=*), parameter :: SPACE = ' ' - character(len=*), parameter :: EXPECTED_UNITS = 'seconds' - character(len=*), parameter :: EXPECTED_PREPOSITION = 'since' - character(len=*), parameter :: EXPECTED_UNITS_STRING = EXPECTED_UNITS // & - SPACE // EXPECTED_PREPOSITION // SPACE // '1999-12-31 23:59:59' - integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_UNITS_STRING) - - character(len=:), allocatable :: actual_units_string - - actual_units_string = make_units_string(EXPECTED_UNITS, EXPECTED_PREPOSITION, YY, MM, DD, H, M, S) - @assertEqual(EXPECTED_LENGTH, len_trim(actual_units_string), "Incorrect length for actual_units_string") - @assertEqual(EXPECTED_UNITS_STRING, actual_units_string, "Units_string's do not match.") - - end subroutine test_make_units_string - -! @Test -! subroutine test_convert_NetCDF_DateTime_to_ESMF() -! character(len=*), parameter :: expected_tunit = 'seconds' -! integer, parameter :: int_time = 1800 -! character(len=*), parameter :: units_string = expected_tunit // ' since 2012-08-26 12:36:37' -! character(len=*), parameter :: start_time_iso_string = '2012-08-26T12:36:37' -! character(len=*), parameter :: time_iso_string = '2012-08-26T13:06:37' -! type(ESMF_TimeInterval) :: expected_interval -! type(ESMF_Time) :: expected_start_time -! type(ESMF_Time) :: expected_time -! -! type(ESMF_TimeInterval) :: interval -! type(ESMF_Time) :: start_time -! type(ESMF_Time) :: time -! character(len=:), allocatable :: tunit -! integer :: rc, status -! -! call ESMF_TimeSet(expected_start_time, timeString=start_time_iso_string, _RC) -! call ESMF_TimeSet(expected_time, timeString=time_iso_string, _RC) -! call ESMF_TimeIntervalSet(expected_interval, startTime=expected_start_time, s=int_time, _RC) -! -! call convert_NetCDF_DateTime_to_ESMF(int_time, units_string, interval, start_time, time=time, tunit=tunit, _RC) -! @assertTrue(expected_start_time == start_time, 'Mismatch for start_time') -! @assertTrue(expected_time == time, 'Mismatch for time') -! @assertTrue(expected_interval == interval, 'Mismatch for interval') -! -! end subroutine test_convert_NetCDF_DateTime_to_ESMF - -! @Test -! subroutine test_convert_ESMF_to_NetCDF_DateTime() -! character(len=*), parameter :: units = 'seconds' -! character(len=*), parameter :: start_time_iso_string = '2013-08-26T12:34:56' -! type(ESMF_Time) :: start_time -! character(len=*), parameter :: time_iso_string = '2013-08-26T13:04:56' -! type(ESMF_Time) :: time -! type(ESMF_TimeInterval) :: interval -! integer, parameter :: expected_duration = 1800 -! character(len=*), parameter :: expected_units_string = units // ' since 2013-08-26 12:34:56' -! integer :: duration -! character(len=:), allocatable :: units_string -! integer :: rc, status -! -! call ESMF_TimeSet(start_time, start_time_iso_string, _RC) -! call ESMF_TimeSet(time, time_iso_string, _RC) -! call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) -! -! call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, time=time, _RC) -! @assertEqual(expected_duration, duration, 'Using time, expected_duration /= duration') -! @assertEqual(expected_units_string, units_string, 'Using time, expected_units_strin g/= units_string') -! -! call convert_ESMF_to_NetCDF_DateTime(units, start_time, duration, units_string, interval=interval, _RC) -! @assertEqual(expected_duration, duration, 'Using interval, expected_duration /= duration') -! @assertEqual(expected_units_string, units_string, 'Using interval, expected_units_strin g/= units_string') -! -! end subroutine test_convert_ESMF_to_NetCDF_DateTime - @Test - subroutine test_make_ESMF_TimeInterval_integer() - character(len=*), parameter :: units = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - integer, parameter :: duration = 1800 - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - integer :: rc, status - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s=duration, _RC) - call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) - @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') - - end subroutine test_make_ESMF_TimeInterval_integer - - @Test - subroutine test_make_NetCDF_DateTime_duration_integer() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - integer, parameter :: expected_duration = 1800 - integer :: duration - integer :: status, rc - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) - - call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) - @assertEqual(expected_duration, duration, 'duration does not match.') - - end subroutine test_make_NetCDF_DateTime_duration_integer - -! @Test -! subroutine test_make_NetCDF_DateTime_units_string() -! type(ESMF_Time) :: start_time -! character(len=*), parameter :: tunit = 'seconds' -! character(len=*), parameter :: expected = tunit // ' since 2012-08-26 08:36:37' -! character(len=:), allocatable :: actual -! integer :: status -! -! call ESMF_TimeSet(start_time, yy=2012, mm=08, dd=26, h=08, m=36, s=37, rc=status) -! @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') -! call make_NetCDF_DateTime_units_string(start_time, tunit, actual, rc=status) -! @assertTrue(status == SUCCESS, 'Failed to make units_string') -! @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) -! end subroutine test_make_NetCDF_DateTime_units_string - -! @Test -! subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString() -! type(ESMF_Time) :: esmf_datetime -! character(len=*), parameter :: expected = '2022-08-26 07:30:37' -! integer, parameter :: yy = 2022 -! integer, parameter :: mm = 08 -! integer, parameter :: dd = 26 -! integer, parameter :: h = 07 -! integer, parameter :: m = 30 -! integer, parameter :: s = 37 -! character(len=:), allocatable :: actual -! integer :: status, rc -! -! call ESMF_TimeSet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) -! call convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, actual, _RC) -! @assertEqual(expected, actual, 'Strings don''t match: ' // expected // '/=' // actual) -! end subroutine test_convert_ESMF_Time_to_NetCDF_DateTimeString - - @Test - subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() - character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' - type(ESMF_Time) :: etime - integer :: yy, mm, dd, h, m, s - integer :: status, rc - - call convert_NetCDF_DateTimeString_to_ESMF_Time(netcdf_string, etime, _RC) - call ESMF_TimeGet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - @assertEqual(2023, yy, 'Incorrect year') - @assertEqual(01, mm, 'Incorrect month') - @assertEqual(31, dd, 'Incorrect day') - @assertEqual(14, h, 'Incorrect hour') - @assertEqual(04, m, 'Incorrect minute') - @assertEqual(37, s, 'Incorrect second') - - end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time - -! @Test -! subroutine test_is_time_unit() -! -! @assertTrue(is_time_unit('years')) -! @assertTrue(is_time_unit('months')) -! @assertTrue(is_time_unit('days')) -! @assertTrue(is_time_unit('hours')) -! @assertTrue(is_time_unit('minutes')) -! @assertTrue(is_time_unit('seconds')) -! @assertTrue(is_time_unit('milliseconds')) -! @assertTrue(is_time_unit(' milliseconds ')) -! -! @assertFalse(is_time_unit('nanoseconds')) -! @assertFalse(is_time_unit('year')) -! -! end subroutine test_is_time_unit - - @test - subroutine test_get_shift_sign() - character(len=:), allocatable :: preposition - integer, parameter :: expected = 1 - - preposition = 'since' - @assertEqual(expected, get_shift_sign(preposition)) - preposition = 'before' - @assertFalse(get_shift_sign(preposition) == expected) - preposition = '' - @assertFalse(get_shift_sign(preposition) == expected) - end subroutine test_get_shift_sign - - @test - subroutine test_split_chars() - character(len=*), parameter :: head = 'head' - character(len=*), parameter :: tail = 'tail' - character(len=*), parameter :: delim = '::' - character(len=:), allocatable :: test_string - character(len=:), allocatable :: parts(:) - - test_string = head // delim // tail - parts = split(test_string, delim) - @assertEqual(2, size(parts), 'Two parts expected.') - @assertEqual(head, parts(1), 'Part 1 does not match head.') - @assertEqual(tail, parts(2), 'Part 2 does not match tail.') - - test_string = delim // tail - parts = split(test_string, delim) - @assertEqual(tail, parts(2), 'Part 2 does not match tail.') - @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') - - test_string = head // delim - parts = split(test_string, delim) - @assertEqual(head, parts(1), 'Part 1 does not match head.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - test_string = head // ' ' // tail - parts = split(test_string, delim) - @assertEqual(test_string, parts(1), 'Part 1 does not match test_string.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - test_string = '' - parts = split(test_string, delim) - @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - end subroutine test_split_chars - - @test - subroutine test_split_all_iterative() - integer, parameter :: N = 6 - integer, parameter :: SLEN = 4 - character(len=SLEN), parameter :: chunk(N) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] - character(len=:), allocatable :: dlm - character(len=:), allocatable :: test_string - character(len=:), allocatable :: parts(:) - integer :: i - - dlm = ' ' - test_string = 'mice' // dlm // 'dogs' // dlm // 'rats' // dlm // 'fish' // dlm // 'deer' // dlm // 'pigs' - - parts = split_all(test_string, dlm) - @assertEqual(size(parts), size(chunk), 'Number of parts do not match.') - do i = 1, size(chunk) - @assertEqual(chunk(i), parts(i)) - end do - - end subroutine test_split_all_iterative - - @test - subroutine test_is_valid_netcdf_datetime_string() - character(len=:), allocatable :: string - -! string = '' -! @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23:59:59' - @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970:01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23-59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01T23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - end subroutine test_is_valid_netcdf_datetime_string - - @test - subroutine test_convert_to_integer() - character(len=:), allocatable :: str - integer :: expected, actual, status - - expected = 2023 - str = '2023' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = -2023 - str = '-2023' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = 0 - str = '0' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = 0 - str = '0.0' - call convert_to_integer(str, actual, rc = status) - @assertTrue(.not. status == SUCCESS, str // ' should not convert.') - - end subroutine test_convert_to_integer - - @test - subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer() - integer :: duration - integer :: yy, mm, dd, h, m, s, m_time + subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() + type(ESMF_Time) :: time + character(len=:), allocatable :: units_string + integer :: duration, expected_duration character(len=:), allocatable :: units character(len=:), allocatable :: preposition - character(len=:), allocatable :: units_string - type(ESMF_Time) :: time, esmf_time + integer :: yy, mm, dd, h, m, s, m_time integer :: status yy = 1999 @@ -440,26 +46,25 @@ contains s = 59 units = 'seconds' preposition = 'since' - duration = ( m_time - m ) * SECONDS_PER_MINUTE + expected_duration = (m_time - m) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") + @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create ESMF_Time') - call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) - @assertTrue(status == SUCCESS, 'Conversion failed') - - @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') + call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) + @assertTrue(status == SUCCESS, 'Failed to get duration time') + @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') - end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer + end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer - @test - subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() + @Test + subroutine test_get_NetCDF_duration_from_ESMF_Time_real() type(ESMF_Time) :: time character(len=:), allocatable :: units_string - integer :: duration, expected_duration + real(kind=ESMF_KIND_R8) :: duration, expected_duration character(len=:), allocatable :: units character(len=:), allocatable :: preposition integer :: yy, mm, dd, h, m, s, m_time @@ -480,17 +85,17 @@ contains @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create ESMF_Time') + @assertTrue(status == SUCCESS, 'Failed to create time') call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) @assertTrue(status == SUCCESS, 'Failed to get duration time') @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') - end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer + end subroutine test_get_NetCDF_duration_from_ESMF_Time_real - @test - subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real() - real(kind=ESMF_KIND_R8) :: duration + @Test + subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer() + integer :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition @@ -510,61 +115,26 @@ contains duration = ( m_time - m ) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') - - @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') - - end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real - - @test - subroutine test_make_ESMF_TimeInterval_real() - character(len=*), parameter :: units = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - real(kind=ESMF_KIND_R8), parameter :: duration = 1800 - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - integer :: rc, status - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s_r8=duration, _RC) - call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) - @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') + @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') - end subroutine test_make_ESMF_TimeInterval_real + end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer @Test - subroutine test_make_NetCDF_DateTime_duration_real() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - real(kind=ESMF_KIND_R8), parameter :: expected_duration = 1800 + subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real() real(kind=ESMF_KIND_R8) :: duration - integer :: status, rc - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=expected_duration, _RC) - - call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) - @assertEqual(expected_duration, duration, 'int_time does not match.') - - end subroutine test_make_NetCDF_DateTime_duration_real - - @test - subroutine test_get_NetCDF_duration_from_ESMF_Time_real() - type(ESMF_Time) :: time - character(len=:), allocatable :: units_string - real(kind=ESMF_KIND_R8) :: duration, expected_duration + integer :: yy, mm, dd, h, m, s, m_time character(len=:), allocatable :: units character(len=:), allocatable :: preposition - integer :: yy, mm, dd, h, m, s, m_time + character(len=:), allocatable :: units_string + type(ESMF_Time) :: time, esmf_time integer :: status yy = 1999 @@ -576,97 +146,19 @@ contains s = 59 units = 'seconds' preposition = 'since' - expected_duration = (m_time - m) * SECONDS_PER_MINUTE + duration = ( m_time - m ) * SECONDS_PER_MINUTE units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create time') - - call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) - @assertTrue(status == SUCCESS, 'Failed to get duration time') - @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') + call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') - end subroutine test_get_NetCDF_duration_from_ESMF_Time_real + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) + @assertTrue(status == SUCCESS, 'Conversion failed') - @test - subroutine test_is_digit_string() - character(len=:), allocatable :: test_string - - test_string = '1' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = '9362754810' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = '125 ' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = 'ADFG' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '1ADFG' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '1213A' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = ' 1213' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = ' ' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '%^*' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '9%^*7' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - end subroutine test_is_digit_string - - @test - subroutine test_convert_to_real() - character(len=:), allocatable :: str - real(kind=ESMF_KIND_R8) :: expected, actual - real(kind=ESMF_KIND_R8), parameter :: RELATIVE_TOLERANCE = 1D-08 - real(kind=ESMF_KIND_R8) :: tolerance - integer :: status + @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') - expected = 6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '6.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = -6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '-6.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 2023 - tolerance = expected * RELATIVE_TOLERANCE - str = '2023' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 0.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '0.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 0.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = 'asdf6.015625' - call convert_to_real(str, actual, rc = status) - @assertTrue(.not. status == SUCCESS, str // ' should not convert.') - - end subroutine test_convert_to_real + end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real end module test_MAPL_NetCDF diff --git a/base/tests/test_MAPL_NetCDF_helpers.F90 b/base/tests/test_MAPL_NetCDF_helpers.F90 new file mode 100644 index 000000000000..4a2ed06c185e --- /dev/null +++ b/base/tests/test_MAPL_NetCDF_helpers.F90 @@ -0,0 +1,67 @@ +module test_MAPL_NetCDF_helpers + + use ESMF + + implicit none + + integer, parameter :: SUCCESS = 0 + +contains +!=============================================================================== +! HELPERS +!=============================================================================== + function make_datetime_string(yy, mm, dd, h, m, s) result(datetime_string) + integer, intent(in) :: yy, mm, dd, h, m, s + character(len=32) :: datetime_string + character(len=*), parameter :: fmt_string = '(I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' + integer :: iostat_ + + write(datetime_string, fmt=fmt_string, iostat=iostat_) yy, mm, dd, h, m, s + if(iostat_ == SUCCESS) return + datetime_string = '' + + end function make_datetime_string + + function make_units_string(units, preposition, yy, mm, dd, h, m, s) result(units_string) + character(len=*), intent(in) :: units + character(len=*), intent(in) :: preposition + integer, intent(in) :: yy, mm, dd, h, m, s + character(len=132) :: units_string + character(len=:), allocatable :: datetime_string + character(len=*), parameter :: SPACE = ' ' + + units_string = '' + datetime_string = make_datetime_string(yy, mm, dd, h, m, s) + if(len_trim(datetime_string) == 0) return + units_string = trim(units) // SPACE // trim(preposition) // SPACE // datetime_string + + end function make_units_string + + logical function rational_equals(na, nb) + integer, intent(in) :: na(2) + integer, intent(in) :: nb(2) + + rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) + + end function rational_equals + + function ESMF_Times_Equal(timeu, timev) result(tval) + type(ESMF_Time), intent(in) :: timeu, timev + logical :: tval + integer :: uyy, umm, udd, uh, um, us, usN, usD + integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD + integer :: status + + tval = .FALSE. + call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) + if(status /= SUCCESS) return + call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) + if(status /= SUCCESS) return + + tval = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & + .and. (uh == vh) .and. (um == vm) .and. (us == vs) & + .and. rational_equals([usN, usD], [vsN, vsD]) ) + + end function ESMF_Times_Equal + +end module test_MAPL_NetCDF_helpers diff --git a/base/tests/test_MAPL_NetCDF_private.pf b/base/tests/test_MAPL_NetCDF_private.pf new file mode 100644 index 000000000000..614d50211a55 --- /dev/null +++ b/base/tests/test_MAPL_NetCDF_private.pf @@ -0,0 +1,371 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +! These tests should only run when you are debugging. +!=============================================================================== +! TEST_MAPL_NETCDF_PRIVATE +!=============================================================================== +module test_MAPL_NetCDF_private + + use MAPL_NetCDF + use test_MAPL_NetCDF_helpers + use MAPL_ExceptionHandling + use ESMF + use pfunit + + implicit none + +contains + + @Test + subroutine test_make_ESMF_TimeInterval_integer() + character(len=*), parameter :: units = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + integer, parameter :: duration = 1800 + type(ESMF_TimeInterval) :: expected_interval + type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + integer :: rc, status + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s=duration, _RC) + call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) + @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') + + end subroutine test_make_ESMF_TimeInterval_integer + + @Test + subroutine test_make_NetCDF_DateTime_duration_integer() + character(len=*), parameter :: tunit = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time + integer, parameter :: expected_duration = 1800 + integer :: duration + integer :: status, rc + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) + + call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) + @assertEqual(expected_duration, duration, 'duration does not match.') + + end subroutine test_make_NetCDF_DateTime_duration_integer + + @Test + subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() + character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' + type(ESMF_Time) :: etime + integer :: yy, mm, dd, h, m, s + integer :: status, rc + + call convert_NetCDF_DateTimeString_to_ESMF_Time(netcdf_string, etime, _RC) + call ESMF_TimeGet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + @assertEqual(2023, yy, 'Incorrect year') + @assertEqual(01, mm, 'Incorrect month') + @assertEqual(31, dd, 'Incorrect day') + @assertEqual(14, h, 'Incorrect hour') + @assertEqual(04, m, 'Incorrect minute') + @assertEqual(37, s, 'Incorrect second') + + end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time + + @Test + subroutine test_get_shift_sign() + character(len=:), allocatable :: preposition + integer, parameter :: expected = 1 + + preposition = 'since' + @assertEqual(expected, get_shift_sign(preposition)) + preposition = 'before' + @assertFalse(get_shift_sign(preposition) == expected) + preposition = '' + @assertFalse(get_shift_sign(preposition) == expected) + end subroutine test_get_shift_sign + + @Test + subroutine test_split_chars() + character(len=*), parameter :: head = 'head' + character(len=*), parameter :: tail = 'tail' + character(len=*), parameter :: delim = '::' + character(len=:), allocatable :: test_string + character(len=:), allocatable :: parts(:) + + test_string = head // delim // tail + parts = split(test_string, delim) + @assertEqual(2, size(parts), 'Two parts expected.') + @assertEqual(head, parts(1), 'Part 1 does not match head.') + @assertEqual(tail, parts(2), 'Part 2 does not match tail.') + + test_string = delim // tail + parts = split(test_string, delim) + @assertEqual(tail, parts(2), 'Part 2 does not match tail.') + @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') + + test_string = head // delim + parts = split(test_string, delim) + @assertEqual(head, parts(1), 'Part 1 does not match head.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + test_string = head // ' ' // tail + parts = split(test_string, delim) + @assertEqual(test_string, parts(1), 'Part 1 does not match test_string.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + test_string = '' + parts = split(test_string, delim) + @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') + @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') + + end subroutine test_split_chars + + @Test + subroutine test_split_all_iterative() + integer, parameter :: N = 6 + integer, parameter :: SLEN = 4 + character(len=SLEN), parameter :: chunk(N) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] + character(len=:), allocatable :: dlm + character(len=:), allocatable :: test_string + character(len=:), allocatable :: parts(:) + integer :: i + + dlm = ' ' + test_string = 'mice' // dlm // 'dogs' // dlm // 'rats' // dlm // 'fish' // dlm // 'deer' // dlm // 'pigs' + + parts = split_all(test_string, dlm) + @assertEqual(size(parts), size(chunk), 'Number of parts do not match.') + do i = 1, size(chunk) + @assertEqual(chunk(i), parts(i)) + end do + + end subroutine test_split_all_iterative + + @Test + subroutine test_is_valid_netcdf_datetime_string() + character(len=:), allocatable :: string + + string = '1970-01-01 23:59:59' + @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') + + string = '1970-01-01 23:59:59' + @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') + + string = '1970:01-01 23:59:59' + @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') + + string = '1970-01-01 23-59:59' + @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') + + string = '1970-01-01T23:59:59' + @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') + + end subroutine test_is_valid_netcdf_datetime_string + + @Test + subroutine test_convert_to_integer() + character(len=:), allocatable :: str + integer :: expected, actual, status + + expected = 2023 + str = '2023' + call convert_to_integer(str, actual, rc = status) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + + expected = -2023 + str = '-2023' + call convert_to_integer(str, actual, rc = status) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + + expected = 0 + str = '0' + call convert_to_integer(str, actual, rc = status) + @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, 'Incorrect conversion: ' // str) + + expected = 0 + str = '0.0' + call convert_to_integer(str, actual, rc = status) + @assertTrue(.not. status == SUCCESS, str // ' should not convert.') + + end subroutine test_convert_to_integer + + @Test + subroutine test_make_ESMF_TimeInterval_real() + character(len=*), parameter :: units = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + real(kind=ESMF_KIND_R8), parameter :: duration = 1800 + type(ESMF_TimeInterval) :: expected_interval + type(ESMF_Time) :: start_time + type(ESMF_TimeInterval) :: interval + integer :: rc, status + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s_r8=duration, _RC) + call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) + @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') + + end subroutine test_make_ESMF_TimeInterval_real + + @Test + subroutine test_make_NetCDF_DateTime_duration_real() + character(len=*), parameter :: tunit = 'seconds' + character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' + type(ESMF_TimeInterval) :: interval + type(ESMF_Time) :: start_time + real(kind=ESMF_KIND_R8), parameter :: expected_duration = 1800 + real(kind=ESMF_KIND_R8) :: duration + integer :: status, rc + + call ESMF_TimeSet(start_time, iso_string, _RC) + call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=expected_duration, _RC) + + call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) + @assertEqual(expected_duration, duration, 'int_time does not match.') + + end subroutine test_make_NetCDF_DateTime_duration_real + + @Test + subroutine test_is_digit_string() + character(len=:), allocatable :: test_string + + test_string = '1' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = '9362754810' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = '125 ' + @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') + test_string = 'ADFG' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '1ADFG' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '1213A' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = ' 1213' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = ' ' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '%^*' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '9%^*7' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + test_string = '' + @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') + end subroutine test_is_digit_string + + @Test + subroutine test_convert_to_real() + character(len=:), allocatable :: str + real(kind=ESMF_KIND_R8) :: expected, actual + real(kind=ESMF_KIND_R8), parameter :: RELATIVE_TOLERANCE = 1D-08 + real(kind=ESMF_KIND_R8) :: tolerance + integer :: status + + expected = 6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '6.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = -6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '-6.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 2023 + tolerance = expected * RELATIVE_TOLERANCE + str = '2023' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 0.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '0.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 0.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = '.015625' + call convert_to_real(str, actual, rc = status) + @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) + @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) + + expected = 6.015625 + tolerance = expected * RELATIVE_TOLERANCE + str = 'asdf6.015625' + call convert_to_real(str, actual, rc = status) + @assertTrue(.not. status == SUCCESS, str // ' should not convert.') + + end subroutine test_convert_to_real + + @Test + subroutine test_ESMF_Times_Equal() + integer :: yy = 1957 + integer :: mm = 10 + integer :: dd = 19 + integer :: h = 18 + integer :: m = 37 + integer :: s = 53 + type(ESMF_Time) :: timea, timeb + integer :: status + + call ESMF_TimeSet(timea, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create timea') + call ESMF_TimeSet(timeb, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) + @assertTrue(status == SUCCESS, 'Failed to create timeb') + @assertTrue(timea == timeb, 'ESMF_Time values are not equal.') + @assertTrue(ESMF_Times_Equal(timea, timeb), 'ESMF_Time values do not match.') + + end subroutine test_ESMF_Times_Equal + + @Test + subroutine test_make_datetime_string() + integer, parameter :: YY = 1999 + integer, parameter :: MM = 12 + integer, parameter :: DD = 31 + integer, parameter :: H = 23 + integer, parameter :: M = 59 + integer, parameter :: S = 59 + + character(len=*), parameter :: EXPECTED_DATETIME_STRING = '1999-12-31 23:59:59' + integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_DATETIME_STRING) + + character(len=:), allocatable :: actual_datetime_string + + actual_datetime_string = make_datetime_string(yy, mm, dd, h, m, s) + @assertEqual(EXPECTED_LENGTH, len_trim(actual_datetime_string), 'Incorrect length for datetime string') + @assertEqual(EXPECTED_DATETIME_STRING, trim(actual_datetime_string), 'Datetime strings do not match.') + + end subroutine test_make_datetime_string + + @Test + subroutine test_make_units_string() + integer, parameter :: YY = 1999 + integer, parameter :: MM = 12 + integer, parameter :: DD = 31 + integer, parameter :: H = 23 + integer, parameter :: M = 59 + integer, parameter :: S = 59 + + character(len=*), parameter :: SPACE = ' ' + character(len=*), parameter :: EXPECTED_UNITS = 'seconds' + character(len=*), parameter :: EXPECTED_PREPOSITION = 'since' + character(len=*), parameter :: EXPECTED_UNITS_STRING = EXPECTED_UNITS // & + SPACE // EXPECTED_PREPOSITION // SPACE // '1999-12-31 23:59:59' + integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_UNITS_STRING) + + character(len=:), allocatable :: actual_units_string + + actual_units_string = make_units_string(EXPECTED_UNITS, EXPECTED_PREPOSITION, YY, MM, DD, H, M, S) + @assertEqual(EXPECTED_LENGTH, len_trim(actual_units_string), "Incorrect length for actual_units_string") + @assertEqual(EXPECTED_UNITS_STRING, actual_units_string, "Units_string's do not match.") + + end subroutine test_make_units_string + +end module test_MAPL_NetCDF_private From 941bb5f92af14211182ae9276b1bfed0f79f309e Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 6 Jun 2023 15:47:23 -0400 Subject: [PATCH 08/32] Modify CHANGELOG.md for updated feature --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e13098b48552..a2b21c020fe5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Make the GEOSadas CI build separate as it often fails due to race conditions in GSI +- Update MAPL_NetCDF public subroutine returns and support for real time ### Fixed From 1e90912116e8a800bb5d301afaada283ad33411c Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 7 Jun 2023 11:33:36 -0400 Subject: [PATCH 09/32] Fix gnufortran error with _ASSERT statements with & line continuation --- base/MAPL_NetCDF.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index f0488fad827b..66cfc84555de 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -273,11 +273,13 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, dat integer :: status integer :: yy, mm, dd, h, m, s, i, j character(len=4) :: part + character(len=:), allocatable :: msg _UNUSED_DUMMY(unusable) - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), & - 'Invalid datetime string: ' // datetime_string) + msg = 'Invalid datetime string: ' // datetime_string + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), msg) + i = 1 j = i + 3 @@ -333,11 +335,12 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, character(len=:), allocatable :: part(:) character(len=:), allocatable :: date_string character(len=:), allocatable :: time_string + character(len=:), allocatable :: msg _UNUSED_DUMMY(unusable) - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), & - 'Invalid datetime string: ' // datetime_string) + msg = 'Invalid datetime string: ' // datetime_string + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), msg) part = split_all(datetime_string, PART_DELIM) date_string = part(1) From e4c0a3979fdf03d804536b159303e3750ff80ad3 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 13 Jun 2023 18:12:39 -0400 Subject: [PATCH 10/32] All MAPL.base ctests work for gfortran --- base/MAPL_NetCDF.F90 | 237 +++++++++---------------- base/tests/CMakeLists.txt | 24 +-- base/tests/test_MAPL_NetCDF.pf | 12 +- base/tests/test_MAPL_NetCDF_private.pf | 96 +++++----- 4 files changed, 145 insertions(+), 224 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 66cfc84555de..542887a9a94e 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -29,9 +29,9 @@ module MAPL_NetCDF private - ! LOW-LEVEL -! public :: convert_NetCDF_DateTimeString_to_ESMF_Time, make_NetCDF_DateTime_duration, is_digit_string, get_shift_sign -! public :: make_ESMF_TimeInterval, is_valid_netcdf_datetime_string, convert_to_integer, convert_to_real, split, split_all + ! LOW-LEVEL - keep commented out (private) unless debugging these procedures + public :: convert_NetCDF_DateTimeString_to_ESMF_Time, make_NetCDF_DateTime_duration, is_digit_string, get_shift_sign + public :: make_ESMF_TimeInterval, is_valid_netcdf_datetime_string, convert_to_integer, convert_to_real, split interface make_ESMF_TimeInterval module procedure :: make_ESMF_TimeInterval_integer @@ -44,18 +44,13 @@ module MAPL_NetCDF end interface make_NetCDF_DateTime_duration interface split - module procedure :: split_chars + module procedure :: split_characters end interface split - interface split_all - module procedure :: split_all_iterative - end interface split_all - - character, parameter :: PART_DELIM = ' ' - character, parameter :: ISO_DELIM = 'T' character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' + character, parameter :: DELIMS(3) = [PART_DELIM, DATE_DELIM, TIME_DELIM] character, parameter :: POINT = '.' character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' @@ -74,27 +69,27 @@ module MAPL_NetCDF character, parameter :: MINUS = '-' character(len=*), parameter :: SIGNS = PLUS // MINUS character(len=*), parameter :: EMPTY_STRING = '' + integer, parameter :: MAX_CHARACTER_LENGTH = 64 contains !=============================================================================== -!========================= NEW HIGH-LEVEL PROCEDURES =========================== +!========================= HIGH-LEVEL PROCEDURES =========================== ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) type(ESMF_Time), intent(inout) :: time - character(len=:), allocatable, intent(in) :: units_string + character(len=*), intent(in) :: units_string integer, intent(out) :: duration class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc type(ESMF_Time) :: start_time type(ESMF_TimeInterval) :: interval - character(len=:), allocatable :: parts(:) - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string + character(len=MAX_CHARACTER_LENGTH) :: units + character(len=MAX_CHARACTER_LENGTH) :: preposition + character(len=MAX_CHARACTER_LENGTH) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: remainder integer :: status integer(ESMF_KIND_I8) :: sign_factor @@ -102,16 +97,15 @@ subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, durati _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(trim(units_string), PART_DELIM) - _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') + call split(trim(units_string), units, remainder, PART_DELIM) + call split(trim(remainder), preposition, remainder, PART_DELIM) + datetime_string = trim(remainder) - units = adjustl(parts(1)) - preposition = adjustl(parts(2)) - date_string = adjustl(parts(3)) - time_string = adjustl(parts(4)) - call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(trim(datetime_string), start_time, _RC) interval = time - start_time + call ESMF_TimeIntervalValidate(interval, rc = status) + _ASSERT(status == ESMF_SUCCESS, 'Invalid ESMF_TimeInterval') call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) sign_factor = get_shift_sign(preposition) @@ -132,11 +126,10 @@ subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, type(ESMF_Time) :: start_time type(ESMF_TimeInterval) :: interval - character(len=:), allocatable :: parts(:) - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string + character(len=MAX_CHARACTER_LENGTH) :: units + character(len=MAX_CHARACTER_LENGTH) :: preposition + character(len=MAX_CHARACTER_LENGTH) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: remainder integer :: status integer(ESMF_KIND_I8) :: sign_factor @@ -144,15 +137,11 @@ subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(units_string, PART_DELIM) - _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') - - units = adjustl(parts(1)) - preposition = adjustl(parts(2)) - date_string = adjustl(parts(3)) - time_string = adjustl(parts(4)) + call split(trim(units_string), units, remainder, PART_DELIM) + call split(trim(remainder), preposition, remainder, PART_DELIM) + datetime_string = trim(remainder) - call convert_NetCDF_DateTimeString_to_ESMF_Time(date_string // PART_DELIM // time_string, start_time, _RC) + call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) interval = time - start_time call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) @@ -174,14 +163,12 @@ subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, & type(ESMF_Time), intent(inout) :: time integer, optional, intent(out) :: rc - character(len=:), allocatable :: parts(:) type(ESMF_TimeInterval) :: interval type(ESMF_Time) :: start_time - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=LEN_DATE) :: date_string - character(len=LEN_TIME) :: time_string - character(len=LEN_DATETIME) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: units + character(len=MAX_CHARACTER_LENGTH) :: preposition + character(len=MAX_CHARACTER_LENGTH) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: remainder integer :: signed_duration, sign_factor integer :: status @@ -190,14 +177,9 @@ subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, & _ASSERT(duration >= 0, 'Negative duration not supported') _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(units_string, PART_DELIM) - _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') - - units = adjustl(parts(1)) - preposition = adjustl(parts(2)) - date_string = adjustl(parts(3)) - time_string = adjustl(parts(4)) - datetime_string = date_string // PART_DELIM // time_string + call split(trim(units_string), units, remainder, PART_DELIM) + call split(trim(remainder), preposition, remainder, PART_DELIM) + datetime_string = trim(remainder) sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') @@ -222,14 +204,12 @@ subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, & type(ESMF_Time), intent(inout) :: time integer, optional, intent(out) :: rc - character(len=:), allocatable :: parts(:) type(ESMF_TimeInterval) :: interval type(ESMF_Time) :: start_time - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string - character(len=:), allocatable :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: units + character(len=MAX_CHARACTER_LENGTH) :: preposition + character(len=MAX_CHARACTER_LENGTH) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: remainder real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor integer :: status @@ -238,14 +218,9 @@ subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, & _ASSERT(duration >= 0, 'Negative duration not supported') _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - parts = split_all(units_string, PART_DELIM) - _ASSERT(size(parts) == NUM_PARTS_UNITS_STRING, 'Invalid number of parts in units_string') - - units = adjustl(parts(1)) - preposition = adjustl(parts(2)) - date_string = adjustl(parts(3)) - time_string = adjustl(parts(4)) - datetime_string = date_string // PART_DELIM // time_string + call split(trim(units_string), units, remainder, PART_DELIM) + call split(trim(remainder), preposition, remainder, PART_DELIM) + datetime_string = trim(remainder) sign_factor = get_shift_sign(preposition) _ASSERT(sign_factor /= 0, 'Unrecognized preposition') @@ -260,9 +235,9 @@ subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, & end subroutine get_ESMF_Time_from_NetCDF_DateTime_real -!======================= END NEW HIGH-LEVEL PROCEDURES ========================= +!======================= END HIGH-LEVEL PROCEDURES ========================= !=============================================================================== -!========================= NEW LOWER-LEVEL PROCEDURES ========================== +!========================= LOWER-LEVEL PROCEDURES ========================== ! Convert NetCDF datetime to ESMF_Time subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, datetime, unusable, rc) @@ -330,67 +305,47 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: status - integer :: yy, mm, dd, h, m, s + integer :: yy, mm, dd, h, m real(kind=ESMF_KIND_R8) :: s_r8 - character(len=:), allocatable :: part(:) - character(len=:), allocatable :: date_string - character(len=:), allocatable :: time_string - character(len=:), allocatable :: msg + character(len=MAX_CHARACTER_LENGTH) :: part + character(len=MAX_CHARACTER_LENGTH) :: remainder _UNUSED_DUMMY(unusable) - msg = 'Invalid datetime string: ' // datetime_string - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), msg) - - part = split_all(datetime_string, PART_DELIM) - date_string = part(1) - time_string = part(2) + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid NetCDF datetime string') ! convert first 3 substrings to year, month, day - part = split_all(date_string, DATE_DELIM) + remainder = datetime_string - call convert_to_integer(part(1), yy, rc = status) + call split(trim(remainder), part, remainder, DATE_DELIM) + call convert_to_integer(trim(part), yy, rc = status) _ASSERT(status == 0, 'Unable to convert year string') - call convert_to_integer(part(2), mm, rc = status) + call split(trim(remainder), part, remainder, DATE_DELIM) + call convert_to_integer(trim(part), mm, rc = status) _ASSERT(status == 0, 'Unable to convert month string') - call convert_to_integer(part(3), dd, rc = status) + call split(trim(remainder), part, remainder, PART_DELIM) + call convert_to_integer(trim(part), dd, rc = status) _ASSERT(status == 0, 'Unable to convert day string') ! convert second 3 substrings to hour, minute, second - part = split_all(time_string, TIME_DELIM) - - call convert_to_integer(part(1), h, rc = status) + call split(trim(remainder), part, remainder, TIME_DELIM) + call convert_to_integer(part, h, rc = status) _ASSERT(status == 0, 'Unable to convert hour string') - call convert_to_integer(part(2), m, rc = status) + call split(trim(remainder), part, remainder, TIME_DELIM) + call convert_to_integer(trim(part), m, rc = status) _ASSERT(status == 0, 'Unable to convert minute string') - ! no need to call this unless larger time units are correct - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - - ! Need to see if the seconds portion has fractional portion and handle it. - ! Split seconds string to see if it has a fractional part. - select case(size(split_all(part(3), POINT))) - - ! no fractional portion => use integer - case(1) - call convert_to_integer(part(3), s, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - ! fractional portion => use real(kind=ESMF_KIND_R8) - case(2) - call convert_to_real(part(3), s_r8, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) + part = remainder + call convert_to_real(trim(part), s_r8, rc = status) + _ASSERT(status == 0, 'Unable to convert second string') - ! wrong number of substrings => FAIL - case default - _FAIL('Incorrect number of second parts') + ! no need to call this unless datetime units are correct + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - end select + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) _RETURN(_SUCCESS) @@ -509,10 +464,8 @@ subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, durat select case(trim(adjustl(units))) case('years') _FAIL('Real values for years are not supported.') -! call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) case('months') _FAIL('Real values for months are not supported.') -! call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) case('days') _FAIL('Real values for days are not supported.') case('hours') @@ -529,7 +482,7 @@ subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, durat end subroutine make_NetCDF_DateTime_duration_real -!======================= END NEW LOWER-LEVEL PROCEDURES ======================== +!======================= END LOWER-LEVEL PROCEDURES ======================== !=============================================================================== !============================= UTILITY PROCEDURES ============================== @@ -578,52 +531,34 @@ function get_shift_sign(preposition) character(len=*), intent(in) :: preposition integer :: get_shift_sign integer, parameter :: POSITIVE = 1 + get_shift_sign = 0 if(adjustl(preposition) == 'since') get_shift_sign = POSITIVE - end function get_shift_sign - - ! Split string at delimiter - function split_chars(chars, delimiter) result(pair) - character(len=*), intent(in) :: chars - character(len=*), intent(in) :: delimiter - character(len=len(chars)) :: pair(2) - integer start - - pair = ['', ''] - - start = index(chars, delimiter) - if(start == 0) then - pair(1) = chars - return - end if - - pair(1) = chars(1:(start - 1)) - pair(2) = chars((start+len(delimiter)):len_trim(chars)) - end function split_chars - - function split_all_iterative(string, delimiter) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=:), allocatable :: parts(:) - character(len=:), allocatable :: pair(:) - character(len=:), allocatable :: head - character(len=:), allocatable :: tail - - parts = [trim(string)] + end function get_shift_sign - if((len(string) == 0) .or. (len(delimiter) == 0)) return + subroutine split_characters(characters, token, remainder, delimiters) + character(len=*), intent(in) :: characters + character(len=MAX_CHARACTER_LENGTH), intent(out) :: token + character(len=MAX_CHARACTER_LENGTH), intent(out) :: remainder + character(len=*), optional, intent(in) :: delimiters + character(len=:), allocatable :: delims + integer :: i - tail = parts(1) - parts = [character::] - do while (len(tail) > 0) - pair = split(tail, delimiter) - head = trim(pair(1)) - tail = trim(pair(2)) - if(len(head) > 0) parts = [parts, head] - end do + delims = ' ' + if(present(delimiters)) delims = delimiters + + i = scan(characters, delims) - end function split_all_iterative + if(i > 0) then + token = characters(:(i-1)) + remainder = characters((i+1):) + else + token = characters + remainder = EMPTY_STRING + endif + + end subroutine split_characters ! Convert string representing an integer to the integer subroutine convert_to_integer(string, n, rc) diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 29592dc994b8..f0d7c31c78a7 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -5,21 +5,21 @@ add_definitions(-DUSE_MPI) # as well as the helper procedures used by test_MAPL_NetCDF and test_MAPL_NetCDF_private # make sure to make the private procedures in MAPL_NetCDF public (uncomment the 'public' statements). set (TEST_SRCS - test_Mapl_Base.pf - test_sort.pf +# test_Mapl_Base.pf +# test_sort.pf # Test_CFIO_Bundle.pf - Test_SimpleMAPLcomp.pf - Test_StringGridFactoryMap.pf - Test_GridManager.pf - Test_LatLon_GridFactory.pf - Test_SphericalToCartesian.pf - Test_LatLon_Corners.pf - Test_MAPL_Config.pf - test_DirPath.pf - test_TimeStringConversion.pf +# Test_SimpleMAPLcomp.pf +# Test_StringGridFactoryMap.pf +# Test_GridManager.pf +# Test_LatLon_GridFactory.pf +# Test_SphericalToCartesian.pf +# Test_LatLon_Corners.pf +# Test_MAPL_Config.pf +# test_DirPath.pf +# test_TimeStringConversion.pf test_MAPL_NetCDF.pf test_MAPL_NetCDF_helpers.F90 -# test_MAPL_NetCDF_private.pf + test_MAPL_NetCDF_private.pf # test_MAPL_ISO8601_DateTime_ESMF.pf ) diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 84d4603bb859..28f4fb078849 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -100,7 +100,7 @@ contains character(len=:), allocatable :: units character(len=:), allocatable :: preposition character(len=:), allocatable :: units_string - type(ESMF_Time) :: time, esmf_time + type(ESMF_Time) :: time, etime integer :: status yy = 1999 @@ -117,13 +117,13 @@ contains units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") - call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') - @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer @@ -134,7 +134,7 @@ contains character(len=:), allocatable :: units character(len=:), allocatable :: preposition character(len=:), allocatable :: units_string - type(ESMF_Time) :: time, esmf_time + type(ESMF_Time) :: time, etime integer :: status yy = 1999 @@ -151,13 +151,13 @@ contains units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - call ESMF_TimeSet(esmf_time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') - @assertTrue(ESMF_Times_Equal(esmf_time, time), 'ESMF_Time values do not match.') + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real diff --git a/base/tests/test_MAPL_NetCDF_private.pf b/base/tests/test_MAPL_NetCDF_private.pf index 614d50211a55..97549e46f3e4 100644 --- a/base/tests/test_MAPL_NetCDF_private.pf +++ b/base/tests/test_MAPL_NetCDF_private.pf @@ -83,61 +83,47 @@ contains end subroutine test_get_shift_sign @Test - subroutine test_split_chars() - character(len=*), parameter :: head = 'head' - character(len=*), parameter :: tail = 'tail' - character(len=*), parameter :: delim = '::' - character(len=:), allocatable :: test_string - character(len=:), allocatable :: parts(:) - - test_string = head // delim // tail - parts = split(test_string, delim) - @assertEqual(2, size(parts), 'Two parts expected.') - @assertEqual(head, parts(1), 'Part 1 does not match head.') - @assertEqual(tail, parts(2), 'Part 2 does not match tail.') - - test_string = delim // tail - parts = split(test_string, delim) - @assertEqual(tail, parts(2), 'Part 2 does not match tail.') - @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') - - test_string = head // delim - parts = split(test_string, delim) - @assertEqual(head, parts(1), 'Part 1 does not match head.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - test_string = head // ' ' // tail - parts = split(test_string, delim) - @assertEqual(test_string, parts(1), 'Part 1 does not match test_string.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - test_string = '' - parts = split(test_string, delim) - @assertEqual(0, len_trim(parts(1)),'Part 1 has nonzero length.') - @assertEqual(0, len_trim(parts(2)),'Part 2 has nonzero length.') - - end subroutine test_split_chars - - @Test - subroutine test_split_all_iterative() - integer, parameter :: N = 6 - integer, parameter :: SLEN = 4 - character(len=SLEN), parameter :: chunk(N) = ['mice', 'dogs', 'rats', 'fish', 'deer', 'pigs'] - character(len=:), allocatable :: dlm - character(len=:), allocatable :: test_string - character(len=:), allocatable :: parts(:) - integer :: i - - dlm = ' ' - test_string = 'mice' // dlm // 'dogs' // dlm // 'rats' // dlm // 'fish' // dlm // 'deer' // dlm // 'pigs' - - parts = split_all(test_string, dlm) - @assertEqual(size(parts), size(chunk), 'Number of parts do not match.') - do i = 1, size(chunk) - @assertEqual(chunk(i), parts(i)) - end do - - end subroutine test_split_all_iterative + subroutine test_split_characters() + integer, parameter :: N = 64 + character(len=*), parameter :: PART1 = 'duck' + character(len=*), parameter :: PART2 = 'deer' + character(len=*), parameter :: YEAR = '1984' + character(len=*), parameter :: MONTH = '11' + character(len=*), parameter :: DAY = '30' + character(len=*), parameter :: HOUR = '19' + character(len=*), parameter :: MINUTE = '19' + character(len=*), parameter :: SECOND = '19.327' + character, parameter :: D = '-' + character, parameter :: T = ':' + character, parameter :: S = ' ' + + character(len=N) :: test_string + character(len=N) :: remainder + character(len=N) :: token + character(len=:), allocatable :: delimiters + + delimiters = S + test_string = trim(PART1) // delimiters // trim(PART2) + call split(trim(test_string), token, remainder) + @assertEqual(PART1, token, "First part doesn't match.") + @assertEqual(PART2, remainder, "Second part doesn't match.") + + delimiters = '- :' + test_string = YEAR // D // MONTH // D // DAY // S // HOUR // T // MINUTE // T // SECOND + call split(trim(test_string), token, remainder, trim(delimiters)) + @assertEqual(YEAR, token, "YEAR doesn't match.") + call split(trim(remainder), token, remainder, trim(delimiters)) + @assertEqual(MONTH, token, "MONTH doesn't match.") + call split(trim(remainder), token, remainder, trim(delimiters)) + @assertEqual(DAY, token, "DAY doesn't match.") + call split(trim(remainder), token, remainder, trim(delimiters)) + @assertEqual(HOUR, token, "HOUR doesn't match.") + call split(trim(remainder), token, remainder, trim(delimiters)) + @assertEqual(MINUTE, token, "MINUTE doesn't match.") + call split(trim(remainder), token, remainder, trim(delimiters)) + @assertEqual(SECOND, token, "SECOND doesn't match.") + + end subroutine test_split_characters @Test subroutine test_is_valid_netcdf_datetime_string() From 1397943f0d25874ca62cb4a21859adeb7ac6b9ee Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 26 Jul 2023 11:10:14 -0400 Subject: [PATCH 11/32] Implement new MAPL_CF and modifications to MAPL_DateTimeParsing --- shared/CF_Time.F90 | 20 ++ shared/CF_Time_Integer.F90 | 38 +++ shared/CF_Time_Real.F90 | 38 +++ shared/CF_Time_def.F90 | 27 ++ shared/MAPL_CF_Time.F90 | 444 +++++++++++++++++++++++++ shared/MAPL_CF_Units.F90 | 99 ++++++ shared/MAPL_DateTime_Parsing.F90 | 555 ++++++++++++++++++++++++++++++- 7 files changed, 1204 insertions(+), 17 deletions(-) create mode 100644 shared/CF_Time.F90 create mode 100644 shared/CF_Time_Integer.F90 create mode 100644 shared/CF_Time_Real.F90 create mode 100644 shared/CF_Time_def.F90 create mode 100644 shared/MAPL_CF_Time.F90 create mode 100644 shared/MAPL_CF_Units.F90 diff --git a/shared/CF_Time.F90 b/shared/CF_Time.F90 new file mode 100644 index 000000000000..cdae15a3d3e9 --- /dev/null +++ b/shared/CF_Time.F90 @@ -0,0 +1,20 @@ +module CF_Time_mod + + use CF_Time_def_mod, only: CF_Time + use CF_Time_Integer_mod, only: construct_CF_Time_Integer, CF_Time_Integer + use CF_Time_Real_mod, only: construct_CF_Time_Real, CF_Time_Real + + implicit none + + private + + public :: CF_Time + public :: CF_Time_Integer + public :: CF_Time_Real + + interface CF_Time + module procedure :: construct_CF_Time_Integer + module procedure :: construct_CF_Time_Real + end interface CF_Time + +end module CF_Time_mod diff --git a/shared/CF_Time_Integer.F90 b/shared/CF_Time_Integer.F90 new file mode 100644 index 000000000000..51c640a7a2b6 --- /dev/null +++ b/shared/CF_Time_Integer.F90 @@ -0,0 +1,38 @@ +module CF_Time_Integer_mod + + use CF_Time_def_mod + + implicit none + + private + + public :: CF_Time_Integer + public :: construct_CF_Time_Integer + + type, extends(CF_Time) :: CF_Time_Integer + private + integer :: duration_ + contains + procedure, public, pass(this) :: duration => get_cf_time_duration_integer + end type CF_Time_Integer + +contains + + function construct_CF_Time_Integer(duration, units) result(cft) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time_Integer) :: cft + + cft % duration_ = duration + cft % units_ = units + + end function construct_CF_Time_Integer + + integer function get_cf_time_duration_integer(this) + class(CF_Time_Integer), intent(in) :: this + + get_cf_time_duration_integer = this % duration_ + + end function get_cf_time_duration_integer + +end module CF_Time_Integer_mod diff --git a/shared/CF_Time_Real.F90 b/shared/CF_Time_Real.F90 new file mode 100644 index 000000000000..37f0a81c744f --- /dev/null +++ b/shared/CF_Time_Real.F90 @@ -0,0 +1,38 @@ +module CF_Time_Real_mod + + use CF_Time_def_mod + + implicit none + + private + + public :: CF_Time_Real + public :: construct_CF_Time_Real + + type, extends(CF_Time) :: CF_Time_Real + private + real :: duration_ + contains + procedure, public, pass(this) :: duration => get_cf_time_duration_real + end type CF_Time_Integer + +contains + + function construct_CF_Time_Real(duration, units) result(cft) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time_Integer) :: cft + + cft % duration_ = duration + cft % units_ = units + + end function construct_CF_Time_Real + + real function get_cf_time_duration_real(this) + class(CF_Time_Integer), intent(in) :: this + + get_cf_time_duration_integer = this % duration_ + + end function get_cf_time_duration_real + +end module CF_Time_Real_mod diff --git a/shared/CF_Time_def.F90 b/shared/CF_Time_def.F90 new file mode 100644 index 000000000000..3d1c2355732d --- /dev/null +++ b/shared/CF_Time_def.F90 @@ -0,0 +1,27 @@ +module CF_Time_def_mod + + implicit none + + private + + public :: CF_Time + + type, abstract :: CF_Time + private + character(len=:), allocatable :: units_ + contains + procedure, public, pass(this) :: units => get_cf_time_units + procedure, deferred, public, pass(this) :: duration + end type CF_Time + +contains + + function get_cf_time_units(this) result(units) + class(CF_Time), intent(in) :: this + character(len=:), allocatable :: units + + units = this % units_ + + end function get_cf_time_units + +end module CF_Time_def_mod diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 new file mode 100644 index 000000000000..c93e4288a7bb --- /dev/null +++ b/shared/MAPL_CF_Time.F90 @@ -0,0 +1,444 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_CF_Time + + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_DateTime_Parsing + + implicit none + +! Comment to test all procedures + private + + +! PUBLIC PROCEDURES (ACCESS): + public :: extract_ISO8601_from_CF_Time + public :: extract_CF_Time_duration + public :: extract_CF_Time_units + public :: convert_CF_Time_to_datetime_duration +! Convert ISO8601 datetime string to CF_Time_base_datetime + public :: convert_ISO8601_to_CF_Time_base_datetime + + +! PUBLIC PROCEDURES (INTERFACES): + +! Extract an ISO8601 datetime string from the base datetime string in a CF_Time. + interface extract_ISO8601_from_CF_Time + module procedure :: extract_ISO8601_from_CF_Time_units + module procedure :: extract_ISO8601_from_CF_Time_cf_time + end interface + +! Extract the duration of a CF Time. + interface extract_CF_Time_duration + module procedure :: extract_CF_Time_duration_cf_time_real + module procedure :: extract_CF_Time_duration_cf_time_integer + end interface extract_CF_Time_duration + +! Extract the time units from a CF Time. + interface extract_CF_Time_unit + module procedure :: extract_CF_Time_unit_cf_time + module procedure :: extract_CF_Time_unit_units + end interface extract_CF_Time_unit + +! Extract datetime_duration from CF Time. + interface convert_CF_Time_to_datetime_duration + module procedure :: convert_CF_Time_to_datetime_duration_integer + module procedure :: convert_CF_Time_to_datetime_duration_real + module procedure :: convert_CF_Time_to_datetime_duration_integer_duration + module procedure :: convert_CF_Time_to_datetime_duration_real_duration + end interface convert_CF_Time_to_datetime_duration + + +! PRIVATE INTERFACES: + + interface split + module procedure :: split_characters + end interface split + + +! TYPES (DEFINITIONS): + +! CF_TIME: derived type to hold the data for CF Time values + type, abstract :: CF_Time + public + logical :: is_valid + character(len=:), allocatable :: time_unit + character(len=:), allocatable :: base_datetime + contains + procedure, public, pass(this) :: check => check_cf_time + end type CF_Time + + type, extends(CF_Time) :: CF_Time_Integer + public + integer :: duration + end type CF_Time_Integer + + type, extends(CF_Time) :: CF_Time_Real + public + real(kind=R64) :: duration + end type CF_Time_Real + + interface CF_Time + module procedure :: construct_cf_time_integer + module procedure :: construct_cf_time_real + end interface CF_Time + +! END CF_TIME + + +! CONSTANTS: + integer, parameter :: MAX_CHARACTER_LENGTH = 64 + character, parameter :: DATE_DELIM = '-' + character, parameter :: TIME_DELIM = ':' + character, parameter :: ISO_DELIM = 'T' + character(len=2), parameter :: CF_DELIM = ' ' // ISO_DELIM + character(len=*), parameter = EMPTY_STRING = '' + + +contains + + +! PUBLIC PROCEDURES (DEFINITION): + + subroutine extract_ISO8601_from_CF_Time_units(units, isostring, rc) + character(len=*), intent(in) :: units + character(len=MAX_CHARACTER_LENGTH), intent(out) :: isostring + integer, optional, intent(out) :: rc + type(CF_Time_Integer) :: cft + integer :: status + + call extract_ISO8601_from_CF_Time(CF_Time(0, units), isostring, _RC) + + _RETURN(_SUCCESS) + + end subroutine extract_ISO8601_from_CF_Time_units + + function extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) + class(CF_Time), intent(in) :: cft + character(len=MAX_CHARACTER_LENGTH), intent(out) :: isostring + integer, optional, intent(out) :: rc + integer :: status + + call cft % check(_RC) + + call convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime, isostring, _RC) + + _RETURN(_SUCCESS) + + end function extract_ISO8601_from_CF_Time_cf_time + + subroutine extract_CF_Time_duration_cf_time_real(cft, duration, rc) + class(CF_Time_Real), intent(in) :: cft + real(kind=R64), intent(out) :: duration + integer, optional, intent(out) :: rc + integer :: status + + call cft % check(_RC) + + duration = cft % duration + + _RETURN(_SUCCESS) + + end subroutine extract_CF_Time_duration_cf_time_real + + subroutine extract_CF_Time_duration_cf_time_integer(cft, duration, rc) + class(CF_Time_Integer), intent(in) :: cft + integer, intent(out) :: duration + integer, optional, intent(out) :: rc + integer :: status + + call cft % check(_RC) + + duration = cft % duration + + _RETURN(_SUCCESS) + + end subroutine extract_CF_Time_duration_cf_time_integer + + subroutine extract_CF_Time_unit_cf_time(cft, time_unit, rc) + class(CF_Time), intent(in) :: cft + character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit + integer, optional, intent(out) :: rc + + call cft % check(_RC) + + time_units = cft % time_unit + + _RETURN(_SUCCESS) + + end subroutine extract_CF_Time_unit_cf_time + + subroutine extract_CF_Time_unit_units(units, time_unit, rc) + character(len=*), intent(in) :: units + character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit + integer, optional, intent(out) :: rc + + call extract_CF_Time_units(CF_Time(0, units), time_units, _RC) + + _RETURN(_SUCCESS) + + end subroutine extract_CF_Time_unit_units + + subroutine convert_ISO8601_to_CF_Time_datestring(isostring, datestring, rc) + character(len=*), intent(in) :: isostring + character(len=MAX_CHARACTER_LENGTH), intent(out) :: datestring + integer, optional, intent(out) :: rc + + datestring = remove_zero_pad(isostring) + + _RETURN(_SUCCESS) + + end subroutine convert_ISO8601_to_CF_Time_datestring + + subroutine convert_CF_Time_to_datetime_duration_integer(cft, dt_duration, rc) + class(CF_Time_Integer), intent(in) :: cft + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + integer(kind(TIME_UNIT)) :: tu + + call cft % check(_RC) + + tu = time_unit(cft % time_units()) + if(tu == TIME_UNIT_UNKNOWN) then + _FAIL('Unrecognized time unit in CF Time') + endif + + call dt_duration % set_value(tu, cft % duration) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_integer + + subroutine convert_CF_Time_to_datetime_duration_real(cft, dt_duration, rc) + class(CF_Time_Real), intent(in) :: cft + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + integer(kind(TIME_UNIT)) :: tu + + call cft % check(_RC) + + tu = time_unit(cft % time_units()) + if(tu == TIME_UNIT_UNKNOWN) then + _FAIL('Unrecognized time unit in CF Time') + endif + + call dt_duration % set_value(tu, cft % duration) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_real + + subroutine convert_CF_Time_to_datetime_duration_integer_duration(duration, units, dt_duration, rc) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + + call convert_CF_Time_to_datetime_duration(CF_Time(duration, units), dt_duration, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_integer_duration + + subroutine convert_CF_Time_to_datetime_duration_real_duration(duration, units, dt_duration, rc) + real(kind=R64), intent(in) :: duration + character(len=*), intent(in) :: units + type(datetime_duration), intent(out) :: dt_duration + integer, optional, intent(out) :: rc + integer :: status + + call convert_CF_Time_to_datetime_duration(CF_Time(duration, units), dt_duration, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_CF_Time_to_datetime_duration_real_duration + + function convert_CF_Time_datetime_string_to_ISO8601(datetime_string) result(isodatetime) + character(len=*), intent(in) :: datetime_string + character(len=MAX_CHARACTER_LENGTH) :: isodatetime + character(len=MAX_CHARACTER_LENGTH) :: remainder + ! parts [year, month, day, hour, minute, second) + character(len=MAX_CHARACTER_LENGTH) :: part(NUM_CF_TIME_UNITS) + character(len=MAX_CHARACTER_LENGTH) :: delimiters(NUM_CF_TIME_UNITS) + + datetime = EMPTY_STRING + remainder = datetime_string + + call split(trim(remainder), part(YEAR), remainder, DATE_DELIM) + call split(trim(remainder), part(MONTH), remainder, DATE_DELIM) + call split(trim(remainder), part(DAY), remainder, CF_DELIM) + call split(trim(remainder), part(HOUR), remainder, TIME_DELIM) + call split(trim(remainder), part(MINUTE), remainder, TIME_DELIM) + part(SECOND) = trim(remainder) + + call update_datetime(datetime, part(YEAR), 4, DATE_DELIM) + call update_datetime(datetime, part(MONTH), 2, DATE_DELIM) + call update_datetime(datetime, part(DAY), 2, ISO_DELIM) + call update_datetime(datetime, part(HOUR), 2, TIME_DELIM) + call update_datetime(datetime, part(MINUTE), 2, TIME_DELIM) + call update_datetime(datetime, part(SECOND), 2) + + contains + + subroutine update_datetime(datetime_, text, width, delm) + character(len=MAX_CHARACTER_LENGTH), intent(inout) :: datetime_ + character(len=*), intent(in) :: text + integer, optional, intent(in) :: width + character(len=*), optional, intent(in) :: delm + character(len=MAX_CHARACTER_LENGTH) :: text_ + + text_ = text + if(present(width)) text_ = zero_pad(text, width) + datetime_ = trim(datetime_) // trim(text_) + if(present(delm)) datetime_ = trim(datetime_) // trim(delm) + + end subroutine update_datetime + + end function convert_CF_Time_datetime_string_to_ISO8601 + +! END PUBLIC PROCEDURES (DEFINITION) + + +! CONSTRUCTORS: + +! CF_TIME (CONSTRUCTORS): + + function construct_cf_time_integer(duration, units) result (cft) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time) :: cft + integer :: status + + if(duration < 0) return + + call cft % initialize_cf_time(units, rc=status) + + cft % duration = duration + + cft % valid = status + + end function construct_cf_time_integer + + function construct_cf_time_real(duration, units) result (cft) + real(kind=R64), intent(in) :: duration + character(len=*), intent(in) :: units + type(CF_Time) :: cft + integer :: status + + if(duration < 0) return + + call cft % initialize_cf_time(units, rc=status) + + cft % duration = duration + + cft % valid = status + + end function construct_cf_time_real + + subroutine initialize_cf_time(this, units, rc) + class(CF_time), intent(inout) :: this + character(len=*), intent(in) :: units + integer, optional, intent(out) :: rc + character(len=MAX_CHARACTER_LENGTH) :: token(2), remainder + integer :: i + + if(present(rc)) rc = _FAILURE + + remainder = units + + do i = 1, size(token) + if(len_trim(remainder) == 0) return + call split(trim(remainder), token(i), remainder, CF_DELIM) + end do + + cft % time_unit = token(1) + cft % base_datetime = token(3) + + if(present(rc)) rc = _SUCCESS + + end subroutine initialize_cf_time + + subroutine check_cf_time(this, rc) + class(CF_Time), intent(in) :: this + integer, optional, intent(out) :: rc + integer :: status + + if(.not. this % is_valid) then + _FAIL("Invalid CF_Time") + end if + + end subroutine check_cf_time + +! END CONSTRUCTORS + + +! UTILITY PROCEDURES: + +! ZERO_PAD - UTILITY + function zero_pad(number_string, width) result(padded) + character(len=*), intent(in) :: number_string + integer, intent(in) :: width + character(len=MAX_CHARACTER_LENGTH) :: padded + integer :: num_zeros + + num_zeros = width - len_trim(number_string) + if(num_zeros > 0) then + padded = repeat('0', num_zeros) // number_string + else + padded = number_string + end if + + end function zero_pad + +! SPLITTER - UTILITY + subroutine split_characters(characters, token, remainder, delimiters) + character(len=*), intent(in) :: characters + character(len=MAX_CHARACTER_LENGTH), intent(out) :: token + character(len=MAX_CHARACTER_LENGTH), intent(out) :: remainder + character(len=*), optional, intent(in) :: delimiters + character(len=:), allocatable :: delims + integer :: i + + delims = ' ' + if(present(delimiters)) delims = delimiters + + i = scan(characters, delims) + + if(i > 0) then + token = characters(:(i-1)) + remainder = characters((i+1):) + else + token = characters + remainder = EMPTY_STRING + endif + + end subroutine split_characters + +! REMOVE_ZERO_PAD - UTILITY + function remove_zero_pad(s) result(u) + character(len=*), intent(in) :: s + character(len=len(string)) :: u + character :: c + integer :: i, n + logical :: follows(len(s)) + integer, allocatable :: indices + + indices = .not. findloc((follows_digit(s) .and. (s == '0')), .TRUE.) + u = s(indices) + end function remove_zero_pad + +! FOLLOWS_DIGIT - UTILITY + function follows_digit(s) result(follows) + character(len=*), intent(in) :: s + logical :: follows(len(s)) + + follows(1) = .FALSE. + follows(2:) = is_digit(1:(len(s)-1)) + + end function follows_digit + +end module MAPL_CF_Time diff --git a/shared/MAPL_CF_Units.F90 b/shared/MAPL_CF_Units.F90 new file mode 100644 index 000000000000..46a025a3f9e4 --- /dev/null +++ b/shared/MAPL_CF_Units.F90 @@ -0,0 +1,99 @@ +module MAPL_CF_Units + + use CF_Time_mod + + implicit none + + private + + public :: convert_cf_time_to_iso8601, convert_iso8601_to_cf_time_real, convert_iso8601_to_cf_time_integer + + interface convert_cf_time_to_iso8601 + module procedure :: convert_cf_time_to_iso8601_integer + module procedure :: convert_cf_time_to_iso8601_real + module procedure :: convert_cf_time_to_iso8601_dt + end interface convert_cf_time_to_iso8601 + + character(len=*), parameter :: FRAC_DELIM = '.' + character(len=*), parameter :: TIME_DELIM = ':' + character(len=*), parameter :: DATE_DELIM = '-' + character(len=*), parameter :: DT_DELIM = ' T' + +contains + + subroutine convert_cf_time_to_iso8601_integer(duration, units, isotime, rc) + integer, intent(in) :: duration + character(len=*), intent(in) :: units + character(len=:), allocatable, intent(out) :: isotime + integer, optional, intent(out) :: rc + integer :: status + + end subroutine convert_cf_time_to_iso8601_integer + + subroutine convert_cf_time_to_iso8601_real(duration, units, isotime, rc) + real, intent(in) :: duration + character(len=*), intent(in) :: units + character(len=:), allocatable, intent(out) :: isotime + real, optional, intent(out) :: rc + integer :: status + end subroutine convert_cf_time_to_iso8601_real + + subroutine convert_cf_time_to_iso8601_dt(cftime, isotime, rc) + class(CF_Time), intent(in) :: cftime + character(len=:), allocatable, intent(out) :: isotime + real, optional, intent(out) :: rc + integer :: status + + call convert_cf_time_to_iso8601(cftime % duration(), cftime % units(), isotime, _RC) + + end subroutine convert_cf_time_to_iso8601_dt + + subroutine convert_iso8601_to_cf_time(isotime, cftime, rc) + character(len=*), intent(in) :: isotime + type(CF_Time_Real), intent(out) :: cftime + integer, optional, intent(out) :: rc + character(len=4) :: year + character(len=2) :: month + character(len=2) :: day + character(len=2) :: hour + character(len=2) :: minute + character(len=2) :: second + character(len=:), allocatable :: second_fraction + + + end subroutine convert_iso8601_to_cf_time + + subroutine convert_iso8601_to_cf_time_integer(isotime, cftime, rc) + character(len=*), intent(in) :: isotime + type(CF_Time_Integer), intent(out) :: cftime + integer, optional, intent(out) :: rc + class(CF_Time_Real) :: cftime_real + integer :: status + + call convert_iso8601_to_cf_time(isotime, cftime_real, _RC) + cftime = CF_Time(integer(cftime_real % duration()), cftime_real % units(), _RC) + + end subroutine convert_iso8601_to_cf_time_integer + + function make_CF_Time_reference(parts, zero_pad, cft_ref) result(cft_ref) + character(len=*), intent(in) :: year + character(len=*), intent(in) :: month + character(len=*), intent(in) :: day + character(len=*), intent(in) :: hour + character(len=*), intent(in) :: minute + character(len=*), intent(in) :: second + character(len=*), intent(in) :: second_fraction + logical, optional, intent(in) :: zero_pad + logical, optional, intent(in) :: use_t + character(len=:), allocatable :: cft_ref + end function make_CF_Time_reference + +end module MAPL_CF_Units + +module CF_Time_def_mod + + implicit none + + private + + public :: CF_Time diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 7c26fc227ceb..d11f9caad06d 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -41,13 +41,21 @@ module MAPL_DateTime_Parsing use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling + use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 + implicit none -! private +! PUBLIC ======================================================================= + public :: date_fields public :: time_fields + public :: datetime_duration public :: convert_to_ISO8601DateTime - public :: MAX_LEN + public :: is_digit + public :: is_positive_digit + public :: MAX_CHARACTER_LENGTH + +! private interface operator(.divides.) module procedure :: divides @@ -61,16 +69,9 @@ module MAPL_DateTime_Parsing module procedure :: is_in_open_interval end interface - ! Error handling - integer, parameter :: INVALID = -1 - - ! parameters for processing date, time, and datetime strings - character(len=10), parameter :: DIGIT_CHARACTERS = '0123456789' - - ! Timezone offset for Timezone Z !wdb keep for now - integer, parameter :: Z = 0 - - integer, parameter :: MAX_LEN = 1024 + interface operator(.isvalidindexof.) + module procedure :: valid_index + end interface ! Derived type for communicating date fields internally type :: date_fields @@ -114,6 +115,83 @@ module MAPL_DateTime_Parsing module procedure :: construct_time_fields_null end interface time_fields + type :: datetime_fields + integer :: yy = 0 + integer :: mm = 0 + integer :: dd = 0 + integer :: h = 0 + integer :: m = 0 + integer :: s = 0 + real :: sr8 = 0.0 + contains + procedure, public, pass(this) :: as_array => datetime_fields_as_array + end type datetime_fields + + interface datetime_fields + module procedure :: construct_datetime_fields + module procedure :: construct_datetime_fields_array + interface datetime_fields + + ! DATETIME_DURATION: Derived type for communicating datetime durations internally + + type :: datetime_duration + public + integer :: year, month, day, hour, minute, second + real(kind=R64) :: hour_real, minute_real, second_real + logical :: hour_is_set, minute_is_set, second_is_set + contains + public + procedure, pass(this) :: set_year => set_year_datetime_duration + procedure, pass(this) :: set_month => set_month_datetime_duration + procedure, pass(this) :: set_day => set_day_datetime_duration + procedure, pass(this) :: set_hour => set_hour_datetime_duration + procedure, pass(this) :: set_minute => set_minute_datetime_duration + procedure, pass(this) :: set_second => set_second_datetime_duration + procedure, pass(this) :: set_hour_real => set_hour_real_datetime_duration + procedure, pass(this) :: set_minute_real => set_minute_real_datetime_duration + procedure, pass(this) :: set_second_real => set_second_real_datetime_duration + procedure, pass(this) :: set_real_value => set_real_value_datetime_duration + procedure, pass(this) :: set_integer_value => set_integer_value_datetime_duration + generic :: set_value => set_real_value, set_integer_value + end type datetime_duration + + interface datetime_duration + module procedure :: construct_datetime_duration + end interface datetime_duration + + ! END DATETIME_DURATION + + + ! TIME_UNIT: enumerators for standard handling of time units (strings, etc) + + enum, bind(c) + enumerator :: TIME_UNIT = 0 + enumerator :: YEAR + enumerator :: MONTH + enumerator :: DAY + enumerator :: HOUR + enumerator :: MINUTE + enumerator :: SECOND + enumerator :: LAST_TIME_UNIT + enumerator :: TIME_UNIT_UNKNOWN = -1 + end enum + + integer(kind(TIME_UNIT)), parameter :: NUM_TIME_UNITS = LAST_TIME_UNIT - 1 + + ! END TIME_UNIT + + + ! Error handling + integer, parameter :: INVALID = -1 + + ! parameters for processing date, time, and datetime strings + character(len=10), parameter :: DIGIT_CHARACTERS = '0123456789' + + ! Timezone offset for Timezone Z !wdb keep for now + integer, parameter :: Z = 0 + + integer, parameter :: MAX_CHARACTER_LENGTH = 64 + contains ! NUMBER HANDLING PROCEDURES @@ -122,7 +200,8 @@ module MAPL_DateTime_Parsing pure logical function divides(factor, dividend) integer, intent(in) :: factor integer, intent(in) :: dividend - ! mod returns the remainder of dividend/factor, and if it is 0, factor divides dividend evenly + ! mod returns the remainder of dividend/factor, + ! and if it is 0, factor divides dividend evenly if(factor /= 0) then ! To avoid divide by 0 divides = mod(dividend, factor)==0 else @@ -148,6 +227,12 @@ elemental pure logical function is_digit(c) is_digit = scan(c, DIGIT_CHARACTERS) > 0 end function is_digit + ! Check if c is a positive digit character + elemental pure logical function is_positive_digit(c) + character, intent(in) :: c + is_positive_digit = is_digit(c) .and. (c /= '0') + end function is_positive_digit + ! Check if n is an integer >= 0 pure logical function is_whole_number(n) integer, intent(in) :: n @@ -213,6 +298,7 @@ end function read_whole_number_indexed ! END NUMBER HANDLING PROCEDURES + ! LOW-LEVEL STRING PROCESSING PROCEDURES ! Strip delimiter from string @@ -455,7 +541,7 @@ pure function parse_time(timestring, delimiter) result(fields) character(len=:), allocatable :: timestring_ integer, parameter :: LENGTH = 6 - character, parameter :: DECIMAL_POINT = '.' + character, parameter :: decimal_seconds_POINT = '.' integer, parameter :: FIELDWIDTH = 2 integer, parameter :: MS_WIDTH = 3 integer :: pos @@ -510,9 +596,9 @@ pure function parse_time(timestring, delimiter) result(fields) ! Select portion starting at fields%hour and ending before timezone undelimited = adjustl(timestring_(1:pos-1)) - ! Remove delimiter and decimal point + ! Remove delimiter and decimal_seconds point undelimited = undelimit(undelimited, delimiter) - undelimited=trim(undelimit(undelimited, DECIMAL_POINT)) + undelimited=trim(undelimit(undelimited, decimal_seconds_POINT)) undelimited_length = len(undelimited) ! Check length of undelimited string with or without milliseconds @@ -538,6 +624,8 @@ end function parse_time ! CONSTRUCTORS +! DATE_FIELDS: + pure function construct_date_fields_default(year, month, day) result(fields) integer, intent(in) :: year integer, intent(in) :: month @@ -561,6 +649,9 @@ pure function construct_date_fields_null() result(fields) fields%is_valid_ = .FALSE. end function construct_date_fields_null + +! TIME_FIELDS: + pure function construct_time_fields_default(hour, minute, second, millisecond, & timezone_offset) result(fields) integer, intent(in) :: hour @@ -589,11 +680,90 @@ pure function construct_time_fields_null() result(fields) fields%is_valid_ = .FALSE. end function construct_time_fields_null +! DATETIME_FIELDS: + + pure function construct_datetime_fields(yy, mm, dd, h, m, s, s8) result(fields) + integer, optional, intent(in) :: yy, mm, dd, h, m, s + real(kind=real64), optional, intent(in) :: s8 + type(datetime_fields) :: fields + + if(present(yy)) fields % yy = yy + if(present(mm)) fields % mm = mm + if(present(dd)) fields % dd = dd + if(present(h)) fields % h = h + if(present(m)) fields % m = m + + if(present(s8)) then + fields % s8 = s8 + fields % s = int(s8) + else if(present(s)) + fields % s = s + fields % s8 = real(s, real64) + end if + + end function construct_datetime_fields + + pure function construct_datetime_fields_array(dur, s8) result(fields) + integer, intent(in) :: dur + real(real64), optional, intent(in) :: s8 + type(datetime_fields) :: fields + integer :: yy, mm, dd, h, m, s + + yy = dur(1) + mm = dur(2) + dd = dur(3) + h = dur(4) + m = dur(5) + + if(present(s8)) then + fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s8 = s8) + return + end if + + fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s = s) + + end function construct_datetime_fields_array + + pure function datetime_fields_as_array(this) result(array) + class(datetime_fields), intent(in) :: this + integer :: array(6) + + array = [this % yy, this % mm, this % dd, this % h, this % m, this % s] + + end function datetime_fields_as_array + +! DATETIME_DURATION: + + function construct_datetime_duration() result(that) + type(datetime_duration) :: that + + that % year = 0 + that % month = 0 + that % day = 0 + that % hour = 0 + that % minute = 0 + that % second = 0 + + that % hour_real = 0.0 + that % minute_real = 0.0 + that % second_real = 0.0 + + that % year_is_set = .FALSE. + that % month_is_set = .FALSE. + that % day_is_set = .FALSE. + that % hour_is_set = .FALSE. + that % minute_is_set = .FALSE. + that % second_is_set = .FALSE. + + end function construct_datetime_duration + ! END CONSTRUCTORS ! TYPE-BOUND METHODS +! DATE_FIELDS: + pure integer function get_year_field(this) class(date_fields), intent(in) :: this get_year_field = this%year_ @@ -614,6 +784,9 @@ pure logical function are_valid_date_fields(this) are_valid_date_fields = this%is_valid_ end function are_valid_date_fields + +! TIME_FIELDS: + pure integer function get_hour_field(this) class(time_fields), intent(in) :: this get_hour_field = this%hour_ @@ -643,6 +816,190 @@ pure logical function are_valid_time_fields(this) class(time_fields), intent(in) :: this are_valid_time_fields = this%is_valid_ end function are_valid_time_fields + + + ! DATETIME_DURATION: + + subroutine set_year_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + this % year = val + this % year_is_set = .TRUE. + + _RETURN(_SUCCESS) + + end subroutine set_year_datetime_duration + + subroutine set_month_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + this % month = val + this % month_is_set = .TRUE. + + _RETURN(_SUCCESS) + + end subroutine set_month_datetime_duration + + subroutine set_day_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + this % day = val + this % day_is_set = .TRUE. + + _RETURN(_SUCCESS) + + end subroutine set_day_datetime_duration + + subroutine set_hour_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % hour_is_set, 'Hour has already been set to a real value.') + + this % hour = val + this % hour_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_hour_datetime_duration + + subroutine set_hour_real_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + real(kind=R64), intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % hour_is_set, 'Hour has already been set to an integer value.') + + this % hour_real = val + this % hour_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_hour_real_datetime_duration + + subroutine set_minute_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % minute_is_set, 'Minute has already been set to a real value'.) + + this % minute = val + this % minute_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_minute_datetime_duration + + subroutine set_minute_real_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + real(kind=R64), intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % minute_is_set, 'Minute has already been set to an integer value.') + + this % minute_real = val + this % minute_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_minute_real_datetime_duration + + subroutine set_second_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % second_is_set, 'Minute has already been set to a real value'.) + + this % second = val + this % second_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_second_datetime_duration + + subroutine set_second_real_datetime_duration(this, val, rc) + class(datetime_duration), intent(in) :: this + real(kind=R64), intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(.not. this % second_is_set, 'Second has already been set to an integer value.') + + this % second_real = val + this % second_is_set = .FALSE. + + _RETURN(_SUCCESS) + + end subroutine set_second_real_datetime_duration + + subroutine set_value_datetime_duration_integer(this, tunit, val, rc) + class(datetime_duration), intent(in) :: this + integer(kind(TIME_UNIT)), intent(in) :: tunit + integer, intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + select case(tunit) + case (YEAR) + call this % set_year(val) + case (MONTH) + call this % set_month(val) + case (DAY) + call this % set_day(val) + case (HOUR) + call this % set_hour(val) + case (MINUTE) + call this % set_minute(val) + case (SECOND) + call this % set_second(val) + case default + _FAIL('Invalid Time Unit') + end select + + end subroutine set_value_datetime_duration_integer + + subroutine set_value_datetime_duration_real(this, tunit, val, rc) + class(datetime_duration), intent(in) :: this + integer(kind(TIME_UNIT)), intent(in) :: tunit + real(kind=R64), intent(in) :: val + integer, optional, intent(out) :: rc + integer :: status + + _ASSERT(tunit <= NUM_TIME_UNITS .and. tunit > 0, ) + select case(tunit) + case (HOUR) + call this % set_hour_real(val) + case (MINUTE) + call this % set_minute_real(val) + case (SECOND) + call this % set_second_real(val) + case default + _FAIL('Invalid Time Unit') + end select + + end subroutine set_value_datetime_duration_integer + + ! END CF Time: Type-bound procedues + + +! END TYPE-BOUND METHODS subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) character(len=*), intent(in) :: datetime_string @@ -675,7 +1032,8 @@ subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) undelimited(N(1,HH):N(2,HH)) // ISO_TD // & undelimited(N(1,M):N(2,M)) // ISO_TD // & undelimited(N(1,S):N(2,S)) - if(undelimited_length > MIN_LEN) intermediate = intermediate // ISO_POINT // undelimited(MIN_LEN+1:undelimited_length) + if(undelimited_length > MIN_LEN) intermediate = & + intermediate // ISO_POINT // undelimited(MIN_LEN+1:undelimited_length) iso_string = intermediate @@ -683,6 +1041,9 @@ subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) end subroutine convert_to_ISO8601DateTime + + ! UTILITY PROCEDURES + function is_valid_datestring(datestring, string_format) result(tval) character(len=*), intent(in) :: datestring character(len=*), intent(in) :: string_format @@ -704,4 +1065,164 @@ function is_valid_datestring(datestring, string_format) result(tval) tval = .true. end function is_valid_datestring + + logical function is_in_char_set(element, char_set) + character, intent(in) :: element + character(len=*), intent(in) :: char_set + is_in_set = (verify(element, char_set) == 0) + end function is_in_set + + function find_delta(string, chars, istart, istop_in) result(next) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: chars + integer, intent(in) :: istart + integer, optional, intent(in) :: istop_in + integer :: next + logical :: in_set + integer :: istop + + if(len(chars) == 0) return + if(istart < 1) return + + istop = len(string) + if(istop == 0) return + + if(present(istop_in)) then + if(istop_in > istop) return + istop = istop_in + end if + + if(istop < istart) return + + next = istart + in_set = is_in_char_set(string(next:next), chars) + + do + next = next + 1 + if(next > len(string)) exit + if(in_set .neqv. is_in_char_set(string(next:next), chars)) exit + end do + + end function find_delta + + function find_delta_datestring(string, istart, istop) result(next) + character(len=*), intent(in) :: string + integer, intent(in) :: istart, istop + integer :: next + + next = find_delta(string, DIGITS, istart, istop) + + end function find_delta_datestring + + subroutine split_digit_string_delimited(string, parts, rc) + character(len=*), intent(in) :: string + class(StringVector), intent(inout) :: parts + integer, optional, intent(out) :: rc + integer :: status + integer :: next, start, strlen, last + + strlen = len(string) + _FAIL(strlen == 0, 'Empty string') + + start = 1 + do + next = find_delta_datestring(string, start) + if(.not. (next > start)) exit + last = next - 1 + _ASSERT(last <= strlen, 'Exceeded string length') + parts % push_back(string(start:(next-1))) + start = next + if(start > len(string)) exit + end do + + _RETURN(_SUCCESS) + + end subroutine split_digit_string_delimited + + logical function valid_index(n, string) + integer, intent(in) :: n + character(len=*), intent(in) :: string + + valid_index = .not. (n < 1 .or. n > len(string)) + + end function valid_index + + subroutine split_digit_string_indexed(string, length, parts, rc) + character(len=*), intent(in) :: string + integer, intent(in) :: length(:) + class(StringVector), intent(inout) :: parts + integer, optional, intent(out) :: rc + integer, allocatable :: indices(:, :) + integer :: status + integer :: i + integer :: n(2) + + indices = convert_lengths_to_indices(length) + + do i = 1, length(indices, 2) + n = indices(:,i) + parts % push_back(string(n(1):n(2))) + end do + + _RETURN(_SUCCESS) + + end subroutine split_digit_string_indexed + + function convert_lengths_to_indices(length) result(indices) + integer, intent(in) :: length(:) + integer :: indices(size(length), 2) + integer :: i + + indices(:, 1) = [1, length(1)] + do i = 2, size(indices) + indices(:, i) = [1, length(i)] + indices(i-1) + end do + + end function convert_lengths_to_indices + + +! TIME_UNIT ==================================================================== + + function time_units() result(units) + character(MAX_CHARACTER_LENGTH), allocatable, save :: units(:) + logical, save :: uninitialized = .TRUE. + + if(uninitialized) then + allocate(units(NUM_TIME_UNITS)) + units(YEAR) = "year" + units(MONTH) = "month" + units(DAY) = "day" + units(HOUR) = "hour" + units(MINUTE) = "minute" + units(SECOND) = "second" + uninitialized = .FALSE. + end if + + end function time_units + + function time_unit(unit_name, check_plural) result(n) + character(len=*), intent(in) :: unit_name + logical, intent(in) :: check_plural + character(len=:), allocatable :: unit_name_ + logical :: check_plural_ = .TRUE. + character(len=:), allocatable :: tunits(:) + character(len=:), allocatable :: tunit, unit_name_plural + character, parameter :: PLURAL = 's' + integer(kind(TIME_UNIT)) :: n, i + + if(present(check_plural)) check_plural_ = check_plural + unit_name_ = trim(unit_name) + tunits = time_units() + + n = TIME_UNIT_UNKNOWN + do i = 1, NUM_TIME_UNITS + tunit = trim(tunits(i)) + if((tunit == unit_name_) .or. (check_plural_ .and. ((tunit // PLURAL) == unit_name_))) then + n = i + exit + end if + end do + + end function time_unit + end module MAPL_DateTime_Parsing From cc5ab740087bb46db66a55e006f373ab1bd038f6 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 26 Jul 2023 11:13:40 -0400 Subject: [PATCH 12/32] Modify MAPL_ISO8601_DateTime_ESMF.F90 for MAPL_CF_Time --- base/MAPL_ISO8601_DateTime_ESMF.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/base/MAPL_ISO8601_DateTime_ESMF.F90 b/base/MAPL_ISO8601_DateTime_ESMF.F90 index 11e91b0d97e0..4b87a6170cad 100644 --- a/base/MAPL_ISO8601_DateTime_ESMF.F90 +++ b/base/MAPL_ISO8601_DateTime_ESMF.F90 @@ -7,6 +7,7 @@ module MAPL_ISO8601_DateTime_ESMF use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_ISO8601_DateTime + use MAPL_DateTimeParsing use ESMF implicit none @@ -51,4 +52,8 @@ function convert_ISO8601_to_esmf_timeinterval(isostring, rc) result(interval) _RETURN(_SUCCESS) end function convert_ISO8601_to_esmf_timeinterval + subroutine convert_datetime_fields_to_esmf_timeinterval(datef, timef, interval, rc) + class(datefields) + type(ESMF_TimeInterval), intent(out) :: interval + end subroutine convert_datetime_fields_to_esmf_timeinterval end module MAPL_ISO8601_DateTime_ESMF From 9716813cd3c3dfd22e70365d6dcbe007c3622e98 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 26 Jul 2023 20:22:45 -0400 Subject: [PATCH 13/32] Partial modification --- base/MAPL_NetCDF.F90 | 70 ++++++++++++++++-- shared/MAPL_DateTime_Parsing.F90 | 6 +- shared/tests/test_MAPL_DateTime_Parsing.pf | 82 ++++++++++++++++++++++ 3 files changed, 151 insertions(+), 7 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 542887a9a94e..0ac4a89a553e 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -5,6 +5,70 @@ ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} +module cf_timeunit_mod + + implicit none + + public :: CF_TimeUnit + + private + + type :: CF_TimeUnit + contains + procedure, public, pass(this) :: name + procedure, public, pass(this) :: is_null + end type CF_TimeUnit + + interface CF_TimeUnit + module procedure :: get_cf_timeunit + end interface CF_TimeUnit + + type, extends(CF_TimeUnit) :: CF_TimeUnit_Impl + private + character(len=:), allocatable :: name_ + logical, protected :: is_null_ = .FALSE. + contains + procedure, public, pass(this) :: name => name_impl + procedure, public, pass(this) :: is_null => is_null_impl + end type CF_TimeUnit + + type(CF_TimeUnit_Impl) :: cf_timeunits(0:2) = [CF_TimeUnit('unspecified', .TRUE.),& + CF_TimeUnit('hours'), CF_TimeUnit('minutes'), CF_TimeUnit('seconds')] + + interface CF_TimeUnit_Impl + module procedure :: mk_cf_tunit + end interface CF_TimeUnit_Impl + +contains + + function mk_cf_timenit(unit_name) result(tunit) + character(len=*), intent(in) :: unit_name + type(CF_TimeUnit_Impl) :: tunit + + tunit % name_ = unit_name + + end function mk_cf_timenit + + function get_cf_timeunit(unit_name) result(tunit) + character(len=*), optional, intent(in) :: unit_name + class(CF_TimeUnit) :: tunit + integer :: i + + if(present(unit_name)) then + ! starts at 1 to skip the null unit + do i = 1, size(cf_timeunits) + tunit = cf_timeunits(i) + if(tunit % name() == unit_name) return + end do + end if + + ! if no match, return null unit (index 0) + tunit = cf_timeunits(0) + + end function get_cf_timeunit + +end module cf_timeunit_mod + module MAPL_NetCDF use MAPL_ExceptionHandling @@ -16,6 +80,7 @@ module MAPL_NetCDF public :: get_NetCDF_duration_from_ESMF_Time public :: get_ESMF_Time_from_NetCDF_DateTime + public :: CF_TimeUnit interface get_NetCDF_duration_from_ESMF_Time module procedure :: get_NetCDF_duration_from_ESMF_Time_integer @@ -50,7 +115,6 @@ module MAPL_NetCDF character, parameter :: PART_DELIM = ' ' character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' - character, parameter :: DELIMS(3) = [PART_DELIM, DATE_DELIM, TIME_DELIM] character, parameter :: POINT = '.' character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' @@ -71,6 +135,7 @@ module MAPL_NetCDF character(len=*), parameter :: EMPTY_STRING = '' integer, parameter :: MAX_CHARACTER_LENGTH = 64 + contains !=============================================================================== @@ -291,7 +356,6 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, dat part = datetime_string(i:j) call convert_to_integer(part, s, rc = status) _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) _RETURN(_SUCCESS) @@ -343,8 +407,6 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, _ASSERT(status == 0, 'Unable to convert second string') ! no need to call this unless datetime units are correct - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) _RETURN(_SUCCESS) diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index d11f9caad06d..8b2efc79ed5d 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -541,7 +541,7 @@ pure function parse_time(timestring, delimiter) result(fields) character(len=:), allocatable :: timestring_ integer, parameter :: LENGTH = 6 - character, parameter :: decimal_seconds_POINT = '.' + character, parameter :: DECIMAL_POINT = '.' integer, parameter :: FIELDWIDTH = 2 integer, parameter :: MS_WIDTH = 3 integer :: pos @@ -596,9 +596,9 @@ pure function parse_time(timestring, delimiter) result(fields) ! Select portion starting at fields%hour and ending before timezone undelimited = adjustl(timestring_(1:pos-1)) - ! Remove delimiter and decimal_seconds point + ! Remove delimiter and decimal point undelimited = undelimit(undelimited, delimiter) - undelimited=trim(undelimit(undelimited, decimal_seconds_POINT)) + undelimited=trim(undelimit(undelimited, DECIMAL_POINT)) undelimited_length = len(undelimited) ! Check length of undelimited string with or without milliseconds diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index 00f7bd1e6803..ad81aa9a65f3 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -605,4 +605,86 @@ contains end subroutine test_convert_to_ISO8601DateTime + !@test + subroutine test_construct_datetime_duration() + integer, parameter :: IEX = 0 + real, parameter :: REX = 0.0 + logical, parameter :: LEX = .FALSE. + type(datetime_duration) :: d + d = datetime_duration() + @assertEqual(IEX, d % year, 'year should be 0' + @assertEqual(IEX, d % month, 'month should be 0' + @assertEqual(IEX, d % day, 'day should be 0' + @assertEqual(IEX, d % hour, 'hour should be 0' + @assertEqual(IEX, d % minute, 'minute should be 0' + @assertEqual(IEX, d % second, 'second should be 0' + @assertEqual(REX, d % hour_real, 'hour_real should be 0.0' + @assertEqual(REX, d % minute_real, 'minute_real should be 0.0' + @assertEqual(REX, d % second_real, 'second_real should be 0.0' + @assertFalse(d % hour_is_set, 'hour_is_set should be .FALSE.' + @assertFalse(d % minute_is_set, 'minute_is_set should be .FALSE.' + @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.' + end subroutine test_construct_datetime_duration + + !@test + subroutine test_time_units() + character(len=:), allocatable :: units + units = time_units() + @assertEqual(NUM_TIME_UNITS, size(units), 'time_units has an incorrect size.') + end subroutine test_time_units + + !@test + subroutine test_time_unit() + integer(kind(TIME_UNIT)) :: tu + integer :: i + logical :: check_plural = .FALSE. + character(len=:), allocatable :: run_name + character(len=:), allocatable :: fmt_ = '(I)' + character(len=4) :: run_number + character(len=:), allocatable :: msg + + i = 0 + + msg = 'Incorrect Time Unit for ' + do while(i < 2) + i = i + 1 + write(run_number, fmt=fmt_) i + run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' + @assertEqual(YEAR, time_unit('year'), run_name // msg // 'year.') + @assertEqual(MONTH, time_unit('month'), run_name // msg // 'month.') + @assertEqual(DAY, time_unit('day'), run_name // msg // 'day.') + @assertEqual(HOUR, time_unit('hour'), run_name // msg // 'hour.') + @assertEqual(MINUTE, time_unit('minute'), run_name // msg // 'minute.') + @assertEqual(SECOND, time_unit('second'), run_name // msg // 'second.') + end do + + do while(i < 3) + i = i + 1 + write(run_number, fmt=fmt_) i + run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' + @assertEqual(YEAR, time_unit('years'), run_name // msg // 'years.') + @assertEqual(MONTH, time_unit('months'), run_name // msg // 'months.') + @assertEqual(DAY, time_unit('days'), run_name // msg // 'days.') + @assertEqual(HOUR, time_unit('hours'), run_name // msg // 'hours.') + @assertEqual(MINUTE, time_unit('minutes'), run_name // msg // 'minutes.') + @assertEqual(SECOND, time_unit('seconds'), run_name // msg // 'seconds.') + end do + + msg = 'Should return TIME_UNIT_UNKNOWN' + do while(i < 4) + i = i + 1 + write(run_number, fmt=fmt_) i + run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('years', check_plural), run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('months', check_plural), run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('days'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('hours'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('minutes'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('seconds'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, time_unit('furlong'), check_plural, run_name // msg) + end do + + end subroutine test_time_unit + + end module test_MAPL_DateTime_Parsing From 68db17955cea0dfe23a8cfedba5242d4fc13c842 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Fri, 28 Jul 2023 16:21:43 -0400 Subject: [PATCH 14/32] Undo reset --- .circleci/config.yml | 1 + Apps/time_ave_util.F90 | 16 +- CHANGELOG.md | 34 ++ CMakeLists.txt | 7 +- Testing/Temporary/CTestCostData.txt | 1 + Testing/Temporary/LastTest.log | 3 + Tests/ExtDataRoot_GridComp.F90 | 202 ++++++--- Tests/VarspecDescription.F90 | 2 + base/Base/Base_Base.F90 | 7 - base/Base/Base_Base_implementation.F90 | 56 +-- base/MAPL_ISO8601_DateTime_ESMF.F90 | 6 +- base/MAPL_NewArthParser.F90 | 2 +- base/MAPL_TripolarGridFactory.F90 | 4 - base/NCIO.F90 | 1 - base/tests/CMakeLists.txt.bak | 70 +++ cmake/FindESMF.cmake | 138 ++++++ copy_mapl_netcdf | 449 ++++++++++++++++++++ geom/FieldPointerUtilities.F90 | 97 ++++- gridcomps/Cap/MAPL_Cap.F90 | 21 +- gridcomps/ExtData2G/ExtDataBracket.F90 | 126 ++---- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 27 +- gridcomps/ExtData2G/ExtData_IOBundleMod.F90 | 31 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 1 + griddedio/CMakeLists.txt | 1 + griddedio/DataCollection.F90 | 9 +- griddedio/TileIO.F90 | 121 ++++++ pfio/CMakeLists.txt | 2 +- pfio/MultiGroupServer.F90 | 48 ++- run_cmake | 3 + run_cmake.gfortran | 3 + run_cmake.ifort | 3 + shared/CMakeLists.txt | 1 + shared/MAPL_DateTime_Parsing.F90 | 350 ++++++++------- shared/MAPL_Sleep.F90 | 31 ++ shared/MaplShared.F90 | 1 + shared/tests/test_MAPL_DateTime_Parsing.pf | 47 +- 36 files changed, 1476 insertions(+), 446 deletions(-) create mode 100644 Testing/Temporary/CTestCostData.txt create mode 100644 Testing/Temporary/LastTest.log create mode 100644 base/tests/CMakeLists.txt.bak create mode 100644 cmake/FindESMF.cmake create mode 100644 copy_mapl_netcdf create mode 100644 griddedio/TileIO.F90 create mode 100755 run_cmake create mode 100755 run_cmake.gfortran create mode 100755 run_cmake.ifort create mode 100644 shared/MAPL_Sleep.F90 diff --git a/.circleci/config.yml b/.circleci/config.yml index fe0d9950a295..59e23e5b779b 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -217,6 +217,7 @@ workflows: checkout_mapl_branch: true mepodevelop: false rebuild_procs: 1 + extra_cmake_options: "-DBUILD_WITH_FLAP=ON" build-and-publish-docker: when: diff --git a/Apps/time_ave_util.F90 b/Apps/time_ave_util.F90 index 70bf28ec4199..a275e9c4bc3e 100644 --- a/Apps/time_ave_util.F90 +++ b/Apps/time_ave_util.F90 @@ -1166,12 +1166,14 @@ subroutine get_file_levels(filename,vertical_data,rc) basic_metadata=formatter%read(_RC) call metadata%create(basic_metadata,trim(filename)) lev_name = metadata%get_level_name(_RC) - call metadata%get_coordinate_info(lev_name,coords=levs,coordUnits=lev_units,long_name=long_name,& - standard_name=standard_name,coordinate_attr=vcoord,_RC) - plevs => levs - vertical_data = VerticalData(levels=plevs,vunit=lev_units,vcoord=vcoord,standard_name=standard_name,long_name=long_name, & - force_no_regrid=.true.,_RC) - nullify(plevs) + if (lev_name /= '') then + call metadata%get_coordinate_info(lev_name,coords=levs,coordUnits=lev_units,long_name=long_name,& + standard_name=standard_name,coordinate_attr=vcoord,_RC) + plevs => levs + vertical_data = VerticalData(levels=plevs,vunit=lev_units,vcoord=vcoord,standard_name=standard_name,long_name=long_name, & + force_no_regrid=.true.,_RC) + nullify(plevs) + end if if (present(rc)) then rc=_SUCCESS @@ -1185,7 +1187,7 @@ function has_level(grid,rc) result(grid_has_level) integer, intent(out), optional :: rc integer :: status, global_dims(3) call MAPL_GridGet(grid,globalCellCountPerDim=global_dims,_RC) - grid_has_level = (global_dims(3)/=1) + grid_has_level = (global_dims(3)>1) if (present(rc)) then RC=_SUCCESS end if diff --git a/CHANGELOG.md b/CHANGELOG.md index b73aa12c9823..bab31f14801b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add ability of ExtData to fill variables on MAPL "tile" grids. +- Added print of regrid method during History initialization +- Added ability to use an `ESMF.rc` file to pass in pre-`ESMF_Initialize` options to ESMF (see [ESMF Docs](https://earthsystemmodeling.org/docs/release/latest/ESMF_refdoc/node4.html#SECTION04024000000000000000) for allowed flags. + - NOTE: File *must* be called `ESMF.rc` +- Added ability to run ExtDataDriver.x on a MAPL "tile" grid +- Add ability to introduce a time-step delay in ExtDataDriver.x to simulate the timestep latency of a real model +- Added a MAPL\_Sleep function, equivalent to some vendor supplied but non-standard sleep function - sampling IODA file with trajectory sampler (step-1): make it run - Convert ExtData to use ESMF HConfig for YAML parsing rather than YaFYAML - Set required ESMF version to 8.5.0 @@ -40,6 +47,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Make the GEOSadas CI build separate as it often fails due to race conditions in GSI - Update MAPL_NetCDF public subroutine returns and support for real time - Update CI to use BCs v11.1.0 +- Updates to support building MAPL with spack instead of Baselibs + - Add `FindESMF.cmake` file to `cmake` directory (as it can't easily be found via spack) + - Move `CMAKE_MODULE_PATH` append statement up to find `FindESMF.cmake` before we `find_package(ESMF)` + - Default `BUILD_WITH_FLAP` to `OFF` as we don't build it in spack + - Explicitly build GEOSadas in CI with `-DBUILD_WITH_FLAP=ON` as GEOSadas is still behind in moving to use fArgParse ### Fixed @@ -53,6 +65,28 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Deprecate the use of FLAP for command line parsing in favor of fArgParse. FLAP support will be removed in MAPL 3 +## [2.39.7] - 2023-07-18 + +### Fixed + +- Fix a bug so that MultigroupServer does not allow a file written by multiple processes at the same time. + +## [2.39.6] - 2023-07-18 + +### Changed + +- Relaxed restriction in the tripolar grid factory so that grids can be made even when the decomposition deos not evenly divide the grid dimension so that the factory can be used in utilities where the core count makes such a condition impossible to satisfiy + +### Fixed + +- Fix a bug in `time_ave_util.x` so that it can work with files with no vertical coordinate + +## [2.39.5] - 2023-07-10 + +### Fixed + +- Fixed logic in generating the names of the split fields. If the alias field in the History.rc has separators (;), each substring is used to name the resulting fields. If there are no separators, this will be the exact name of the first split field + ## [2.39.4] - 2023-06-23 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index a507df9057b6..c12b20b235f0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.39.4 + VERSION 2.39.7 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui @@ -58,6 +58,8 @@ if (NOT COMMAND esma) endif () +list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake") + option (BUILD_SHARED_MAPL "Build shared MAPL libraries" ON) if (BUILD_SHARED_MAPL) set (MAPL_LIBRARY_TYPE SHARED) @@ -119,7 +121,7 @@ if (BUILD_WITH_PFLOGGER) endif() endif() -option(BUILD_WITH_FLAP "Use FLAP for command line processing" ON) +option(BUILD_WITH_FLAP "Use FLAP for command line processing" OFF) if (BUILD_WITH_FLAP) find_package(FLAP REQUIRED) endif () @@ -250,7 +252,6 @@ if (PFUNIT_FOUND) endif () # Support for automated code generation -list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake") include(mapl_acg) include(mapl_create_stub_component) add_subdirectory (Apps) diff --git a/Testing/Temporary/CTestCostData.txt b/Testing/Temporary/CTestCostData.txt new file mode 100644 index 000000000000..ed97d539c095 --- /dev/null +++ b/Testing/Temporary/CTestCostData.txt @@ -0,0 +1 @@ +--- diff --git a/Testing/Temporary/LastTest.log b/Testing/Temporary/LastTest.log new file mode 100644 index 000000000000..9b6d6b15b0dd --- /dev/null +++ b/Testing/Temporary/LastTest.log @@ -0,0 +1,3 @@ +Start testing: Jun 14 10:33 EDT +---------------------------------------------------------- +End testing: Jun 14 10:33 EDT diff --git a/Tests/ExtDataRoot_GridComp.F90 b/Tests/ExtDataRoot_GridComp.F90 index 5800b0007045..6bbe85200b62 100644 --- a/Tests/ExtDataRoot_GridComp.F90 +++ b/Tests/ExtDataRoot_GridComp.F90 @@ -1,13 +1,14 @@ - + !------------------------------------------------------------------------- ! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! !------------------------------------------------------------------------- ! #include "MAPL_Generic.h" - + MODULE ExtDataUtRoot_GridCompMod use ESMF use MAPL + use MAPLShared use VarspecDescriptionMod use VarspecDescriptionVectorMod use netcdf @@ -38,6 +39,8 @@ MODULE ExtDataUtRoot_GridCompMod type(StringStringMap) :: fillDefs character(len=ESMF_MAXSTR) :: runMode type(timeVar) :: tFunc + logical :: on_tiles + real :: delay ! in seconds end type SyntheticFieldSupport type :: SyntheticFieldSupportWrapper @@ -66,6 +69,8 @@ subroutine SetServices ( GC, RC ) type(ESMF_Config) :: cf type(SyntheticFieldSupportWrapper) :: synthWrap type(SyntheticFieldSupport), pointer :: synth + logical :: on_tiles + integer :: vloc call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, _RC ) @@ -76,50 +81,57 @@ subroutine SetServices ( GC, RC ) synthWrap%ptr => synth call ESMF_UserCompSetInternalState(gc,wrap_name,synthWrap,status) _VERIFY(status) + call ESMF_ConfigFindLabel(cf,"tiling_file:",isPresent=synth%on_tiles,_RC) + if (synth%on_tiles) then + vloc = MAPL_DimsTileOnly + else + vloc = MAPL_DimsHorzOnly + end if call AddState(GC,CF,"IMPORT",_RC) call AddState(GC,CF,"EXPORT",_RC) + call MAPL_AddInternalSpec(GC,& short_name='time', & long_name='na' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='lats', & long_name='na' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='lons', & long_name='na' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='i_index', & long_name='na' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='j_index', & long_name='na' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='doy', & long_name='day_since_start_of_year' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) call MAPL_AddInternalSpec(GC,& short_name='rand', & long_name='random number' , & units = 'na', & - dims = MAPL_DimsHorzOnly, & + dims = vloc, & vlocation = MAPL_VLocationNone, _RC) @@ -140,7 +152,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config integer :: status character(len=ESMF_MAXSTR) :: comp_name @@ -153,14 +165,23 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(SyntheticFieldSupportWrapper) :: synthWrap type(SyntheticFieldSupport), pointer :: synth => null() character(len=ESMF_MaxStr) :: key, keyVal + type(MAPL_MetaComp), pointer :: MAPL + logical :: isPresent call ESMF_GridCompGet( GC, name=comp_name, config=CF, _RC ) + call MAPL_GetObjectFromGC ( GC, MAPL, _RC ) call ESMF_UserCompGetInternalState(gc,wrap_name,synthWrap,status) _VERIFY(status) synth => synthWrap%ptr call ESMF_ClockGet(Clock,currTime=currTime,_RC) + synth%delay = -1.0 + call ESMF_ConfigFindLabel(cf,label='delay:',isPresent=isPresent,_RC) + if (isPresent) then + call ESMF_ConfigGetAttribute(cf,label='delay:',value=synth%delay,_RC) + end if + call ESMF_ConfigGetDim(cf,nrows,ncolumn,label="FILL_DEF::",rc=status) if (status==ESMF_SUCCESS) then call ESMF_ConfigFindLabel(cf,label="FILL_DEF::",_RC) @@ -177,6 +198,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_GridCreate(GC, _RC) call ESMF_GridCompGet(GC, grid=grid, _RC) + call set_locstream(_RC) !allocate(ak(lm+1),stat=status) !allocate(bk(lm+1),stat=status) !call set_eta(lm,ls,ptop,pint,ak,bk) @@ -189,6 +211,30 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ForceAllocation(Export,_RC) _RETURN(ESMF_SUCCESS) + contains + + subroutine set_locstream(rc) + + integer, optional, intent(out) :: rc + + integer :: status + character(len=ESMF_MAXPATHLEN) :: tile_file + type(ESMF_DistGrid) :: distgrid + type(ESMF_DELayout) :: layout + type(MAPL_LocStream) :: exch + + if (synth%on_tiles) then + call ESMF_ConfigGetAttribute(cf,tile_file,label="tiling_file:",_RC) + call ESMF_GridGet(grid,distGrid=distgrid,_RC) + call ESMF_DistGridGet(distgrid,deLayout=layout,_RC) + call MAPL_LocStreamCreate(exch,layout=layout,filename=tile_file, & + name = 'my_tiles', mask = [MAPL_LAND], grid=grid,_RC) + call MAPL_ExchangeGridSet(gc,exch,_RC) + call MAPL_GenericMakeXchgNatural(MAPL,_RC) + call ESMF_GridCompSet(gc,grid=grid,_RC) + end if + _RETURN(_SUCCESS) + end subroutine set_locstream END SUBROUTINE Initialize_ @@ -231,33 +277,38 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_UserCompGetInternalState(gc,wrap_name,synthWrap,status) _VERIFY(status) synth => synthWrap%ptr - call ESMF_GridCompGet(GC,grid=grid,_RC) - call MAPL_GetPointer(internal,ptrR4,'lons',_RC) - call ESMF_GridGetCoord (Grid, coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptrR8, _RC) - ptrR4=ptrR8 - call MAPL_GetPointer(internal,ptrR4,'lats',_RC) - call ESMF_GridGetCoord (Grid, coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptrR8, _RC) - ptrR4=ptrR8 + if (synth%delay > -1.0) then + call MAPL_Sleep(synth%delay) + end if + if (.not. synth%on_tiles) then + call ESMF_GridCompGet(GC,grid=grid,_RC) + call MAPL_GetPointer(internal,ptrR4,'lons',_RC) + call ESMF_GridGetCoord (Grid, coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptrR8, _RC) + ptrR4=ptrR8 + call MAPL_GetPointer(internal,ptrR4,'lats',_RC) + call ESMF_GridGetCoord (Grid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptrR8, _RC) + ptrR4=ptrR8 + end if select case (trim(synth%runMode)) case(RunModeGenerateExports) - call FillState(internal,export,currTime,grid,synth,_RC) + call FillState(internal,export,currTime,grid,synth,_RC) case(RunModeGenerateImports) - call FillState(internal,import,currTime,grid,synth,_RC) + call FillState(internal,import,currTime,grid,synth,_RC) case(runModecompareImports) call FillState(internal,export,currTime,grid,synth,_RC) - call CompareState(import,export,0.001,_RC) + call CompareState(import,export,0.001,_RC) - case(runModeFillImport) + case(runModeFillImport) ! Nothing to do, we are just letting ExtData run case(runModeFillExportFromImport) @@ -379,9 +430,9 @@ function evaluate_time(this,currTime,rc) result(dt) call ESMF_TimeIntervalSet(yearInterval,yy=yint,_RC) currTime = currTime+yearInterval end if - periodic_time = this%set_time_for_date(currTime,_RC) + periodic_time = this%set_time_for_date(currTime,_RC) if (this%have_offset) then - timeInterval = periodic_time + this%update_offset - this%refTime + timeInterval = periodic_time + this%update_offset - this%refTime else timeInterval = periodic_time - this%refTime end if @@ -418,7 +469,7 @@ function set_time_for_date(this,input_time,rc) result(returned_time) returned_time = input_time else if (new_time < input_time) then returned_time = new_time - else if (new_time > input_time) then + else if (new_time > input_time) then call ESMF_TimeSet(new_time,yy=year,mm=month,dd=day-1,h=hour,m=minute,s=second,_RC) returned_time = new_time end if @@ -437,10 +488,12 @@ subroutine CopyState(inState,outState,rc) integer :: status integer :: I - real, pointer :: IMptr3(:,:,:) => null() - real, pointer :: Exptr3(:,:,:) => null() - real, pointer :: IMptr2(:,:) => null() - real, pointer :: Exptr2(:,:) => null() + real, pointer :: IMptr3(:,:,:) + real, pointer :: Exptr3(:,:,:) + real, pointer :: IMptr2(:,:) + real, pointer :: Exptr2(:,:) + real, pointer :: IMptr1(:) + real, pointer :: Exptr1(:) integer :: itemcountIn,itemCountOut,rank character(len=ESMF_MAXSTR), allocatable :: inNameList(:) character(len=ESMF_MAXSTR), allocatable :: outNameList(:) @@ -462,7 +515,11 @@ subroutine CopyState(inState,outState,rc) call ESMF_StateGet(inState,trim(inNameList(i)),impf,_RC) call ESMF_StateGet(outState,trim(outNameList(i)),expf,_RC) call ESMF_FieldGet(impf,rank=rank,_RC) - if (rank==2) then + if (rank==1) then + call MAPL_GetPointer(inState,IMptr1,inNameList(i),_RC) + call MAPL_GetPointer(outState,Exptr1,inNameList(i),alloc=.true.,_RC) + EXptr1=IMptr1 + else if (rank==2) then call MAPL_GetPointer(inState,IMptr2,inNameList(i),_RC) call MAPL_GetPointer(outState,Exptr2,inNameList(i),alloc=.true.,_RC) EXptr2=IMptr2 @@ -472,7 +529,7 @@ subroutine CopyState(inState,outState,rc) EXptr3=IMptr3 end if end do - deallocate(inNameList,outNameList) + deallocate(inNameList,outNameList) _RETURN(ESMF_SUCCESS) end subroutine CopyState @@ -487,7 +544,7 @@ subroutine FillState(inState,outState,time,grid,Synth,rc) integer, optional, intent(out) :: rc integer :: status - real, pointer :: Exptr2(:,:) => null() + real, pointer :: Exptr2(:,:), Exptr1(:) integer :: itemcount character(len=ESMF_MAXSTR), allocatable :: outNameList(:) type(ESMF_Field) :: expf,farray(7) @@ -497,40 +554,59 @@ subroutine FillState(inState,outState,time,grid,Synth,rc) integer, allocatable :: seeds(:) type(ESMF_VM) :: vm - call MAPL_GridGet(grid,localcellcountperdim=ldims,_RC) - call MAPL_Grid_Interior(grid,i1,in,j1,jn) + if (.not. synth%on_tiles) then + call MAPL_GridGet(grid,localcellcountperdim=ldims,_RC) + call MAPL_Grid_Interior(grid,i1,in,j1,jn) + end if call ESMF_StateGet(outState,itemcount=itemCount,_RC) allocate(outNameList(itemCount),stat=status) _VERIFY(status) call ESMF_StateGet(outState,itemNameList=outNameList,_RC) - call MAPL_GetPointer(inState,exPtr2,'time',_RC) - exPtr2=synth%tFunc%evaluate_time(Time,_RC) + if (synth%on_tiles) then + call MAPL_GetPointer(inState,exPtr1,'time',_RC) + exPtr1=synth%tFunc%evaluate_time(Time,_RC) + else + call MAPL_GetPointer(inState,exPtr2,'time',_RC) + exPtr2=synth%tFunc%evaluate_time(Time,_RC) + end if - call MAPL_GetPointer(inState,exPtr2,'i_index',_RC) - do j = 1,ldims(2) - do i=1,ldims(1) - exPtr2(i,j)=i1+i-1 + if (.not. synth%on_tiles) then + call MAPL_GetPointer(inState,exPtr2,'i_index',_RC) + do j = 1,ldims(2) + do i=1,ldims(1) + exPtr2(i,j)=i1+i-1 + enddo enddo - enddo - call MAPL_GetPointer(inState,exPtr2,'j_index',_RC) - do i = 1,ldims(1) - do j=1,ldims(2) - exPtr2(i,j)=j1+j-1 + call MAPL_GetPointer(inState,exPtr2,'j_index',_RC) + do i = 1,ldims(1) + do j=1,ldims(2) + exPtr2(i,j)=j1+j-1 + enddo enddo - enddo + end if - call MAPL_GetPointer(inState,exPtr2,'doy',_RC) - exPtr2 = compute_doy(time,_RC) + if (synth%on_tiles) then + call MAPL_GetPointer(inState,exPtr1,'doy',_RC) + exPtr1 = compute_doy(time,_RC) + else + call MAPL_GetPointer(inState,exPtr2,'doy',_RC) + exPtr2 = compute_doy(time,_RC) + end if - call MAPL_GetPointer(inState,exPtr2,'rand',_RC) call random_seed(size=seed_size) allocate(seeds(seed_size)) call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm,localPet=mypet,_RC) seeds = mypet call random_seed(put=seeds) - call random_number(exPtr2) + if (synth%on_tiles) then + call MAPL_GetPointer(inState,exPtr1,'rand',_RC) + call random_number(exPtr1) + else + call MAPL_GetPointer(inState,exPtr2,'rand',_RC) + call random_number(exPtr2) + end if call ESMF_StateGet(inState,'time',farray(1),_RC) call ESMF_StateGet(inState,'lons',farray(2),_RC) @@ -564,12 +640,14 @@ subroutine CompareState(State1,State2,tol,rc) real, pointer :: ptr3_2(:,:,:) real, pointer :: ptr2_1(:,:) real, pointer :: ptr2_2(:,:) + real, pointer :: ptr1_1(:) + real, pointer :: ptr1_2(:) integer :: itemcount,rank1,rank2 character(len=ESMF_MAXSTR), allocatable :: NameList(:) logical, allocatable :: foundDiff(:) type(ESMF_Field) :: Field1,Field2 logical :: all_undef1, all_undef2 - + call ESMF_StateGet(State1,itemcount=itemCount,_RC) allocate(NameList(itemCount),stat=status) _VERIFY(status) @@ -588,7 +666,13 @@ subroutine CompareState(State1,State2,tol,rc) end if _ASSERT(rank1==rank2,'needs informative message') foundDiff(i)=.false. - if (rank1==2) then + if (rank1==1) then + call MAPL_GetPointer(state1,ptr1_1,trim(nameList(i)),_RC) + call MAPL_GetPointer(state2,ptr1_2,trim(nameList(i)),_RC) + if (any((ptr1_1-ptr1_2) > tol)) then + foundDiff(i) = .true. + end if + else if (rank1==2) then call MAPL_GetPointer(state1,ptr2_1,trim(nameList(i)),_RC) call MAPL_GetPointer(state2,ptr2_2,trim(nameList(i)),_RC) if (any((ptr2_1-ptr2_2) > tol)) then @@ -601,11 +685,11 @@ subroutine CompareState(State1,State2,tol,rc) foundDiff(i) = .true. end if end if - if (foundDiff(i)) then + if (foundDiff(i)) then _FAIL('found difference when compare state') end if enddo - + _RETURN(ESMF_SUCCESS) end subroutine CompareState @@ -613,9 +697,9 @@ end subroutine CompareState subroutine ForceAllocation(state,rc) type(ESMF_State), intent(inout) :: state integer, optional, intent(out) :: rc - + integer :: status - + real, pointer :: ptr3d(:,:,:) real, pointer :: ptr2d(:,:) integer :: ii diff --git a/Tests/VarspecDescription.F90 b/Tests/VarspecDescription.F90 index 7f08561bd358..499a81d5a9e8 100644 --- a/Tests/VarspecDescription.F90 +++ b/Tests/VarspecDescription.F90 @@ -57,6 +57,8 @@ function new_VarspecDescriptionFromConfig(cf,nwords,rc) result(VarspecDescr) VarspecDescr%dims = MAPL_DimsHorzOnly else if (trim(tmpstring) == 'xyz') then VarspecDescr%dims = MAPL_DimsHorzVert + else if (trim(tmpstring) == 'tileonly') then + VarspecDescr%dims = MAPL_DimsTileOnly end if tmpstring = svec%at(5) if (trim(tmpstring) == 'none') then diff --git a/base/Base/Base_Base.F90 b/base/Base/Base_Base.F90 index 4a134533fb40..ebc4b03667fd 100644 --- a/base/Base/Base_Base.F90 +++ b/base/Base/Base_Base.F90 @@ -58,7 +58,6 @@ module MAPL_Base public MAPL_StateAdd public MAPL_FieldBundleAdd public MAPL_FieldBundleGet - public MAPL_FieldDestroy public MAPL_FieldBundleDestroy public MAPL_GetHorzIJIndex public MAPL_GetGlobalHorzIJIndex @@ -642,12 +641,6 @@ module subroutine MAPL_FieldAttSetI4(FIELD, NAME, VALUE, RC) end subroutine MAPL_FieldAttSetI4 ! ======================================== - module subroutine MAPL_FieldDestroy(Field,RC) - use ESMF, only: ESMF_Field - type(ESMF_Field), intent(INOUT) :: Field - integer, optional, intent(OUT ) :: RC - end subroutine MAPL_FieldDestroy - module subroutine MAPL_FieldBundleDestroy(Bundle,RC) use ESMF, only: ESMF_FieldBundle type(ESMF_FieldBundle), intent(INOUT) :: Bundle diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index 065d10daa49f..627cfa3c2ef4 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -24,6 +24,7 @@ ! !USES: ! use ESMF + use MAPL_Geom use MAPL_Constants use MAPL_RangeMod use MAPL_SphericalGeometry @@ -2644,60 +2645,6 @@ module subroutine MAPL_FieldAttSetI4(FIELD, NAME, VALUE, RC) end subroutine MAPL_FieldAttSetI4 ! ======================================== - module subroutine MAPL_FieldDestroy(Field,RC) - type(ESMF_Field), intent(INOUT) :: Field - integer, optional, intent(OUT ) :: RC - - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_FieldDestroy" - integer :: STATUS - - real(kind=ESMF_KIND_R4), pointer :: VAR_1D(:), VAR_2D(:,:), VAR_3D(:,:,:) - real(kind=ESMF_KIND_R8), pointer :: VR8_1D(:), VR8_2D(:,:), VR8_3D(:,:,:) - integer :: rank - type(ESMF_TypeKind_Flag) :: tk - - call ESMF_FieldGet(Field,typekind=tk,dimCount=rank,rc=status) - _VERIFY(STATUS) - if (tk == ESMF_TYPEKIND_R4 .and. rank == 1) then - call ESMF_FieldGet(Field,0,VAR_1d,rc=status) - _VERIFY(STATUS) - deallocate(Var_1d,stat=status) - _VERIFY(STATUS) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 1) then - call ESMF_FieldGet(Field,0,VR8_1d,rc=status) - _VERIFY(STATUS) - deallocate(VR8_1d,stat=status) - _VERIFY(STATUS) - else if (tk == ESMF_TYPEKIND_R4 .and. rank == 2) then - call ESMF_FieldGet(Field,0,VAR_2d,rc=status) - _VERIFY(STATUS) - deallocate(Var_2d,stat=status) - _VERIFY(STATUS) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 2) then - call ESMF_FieldGet(Field,0,VR8_2d,rc=status) - _VERIFY(STATUS) - deallocate(VR8_2d,stat=status) - _VERIFY(STATUS) - else if (tk == ESMF_TYPEKIND_R4 .and. rank == 3) then - call ESMF_FieldGet(Field,0,VAR_3D,rc=status) - _VERIFY(STATUS) - deallocate(Var_3d,stat=status) - _VERIFY(STATUS) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 3) then - call ESMF_FieldGet(Field,0,VR8_3D,rc=status) - _VERIFY(STATUS) - deallocate(VR8_3d,stat=status) - _VERIFY(STATUS) - else - _FAIL( 'unsupported typekind+rank') - end if - call ESMF_FieldDestroy(Field,rc=status) - _VERIFY(STATUS) - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_FieldDestroy - module subroutine MAPL_FieldBundleDestroy(Bundle,RC) type(ESMF_FieldBundle), intent(INOUT) :: Bundle integer, optional, intent(OUT ) :: RC @@ -3908,7 +3855,6 @@ subroutine genAlias(name, n, splitNameArray, aliasName, rc) deallocate(tmp) ! if the user did no supply enough separated alias field names, ! append 00i to the original field name - if (n==1) nn=0 do i=nn+1,n write(splitNameArray(i),'(A,I3.3)') trim(name), i end do diff --git a/base/MAPL_ISO8601_DateTime_ESMF.F90 b/base/MAPL_ISO8601_DateTime_ESMF.F90 index 4b87a6170cad..891147caf030 100644 --- a/base/MAPL_ISO8601_DateTime_ESMF.F90 +++ b/base/MAPL_ISO8601_DateTime_ESMF.F90 @@ -7,7 +7,7 @@ module MAPL_ISO8601_DateTime_ESMF use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_ISO8601_DateTime - use MAPL_DateTimeParsing + use MAPL_DateTime_Parsing use ESMF implicit none @@ -52,8 +52,4 @@ function convert_ISO8601_to_esmf_timeinterval(isostring, rc) result(interval) _RETURN(_SUCCESS) end function convert_ISO8601_to_esmf_timeinterval - subroutine convert_datetime_fields_to_esmf_timeinterval(datef, timef, interval, rc) - class(datefields) - type(ESMF_TimeInterval), intent(out) :: interval - end subroutine convert_datetime_fields_to_esmf_timeinterval end module MAPL_ISO8601_DateTime_ESMF diff --git a/base/MAPL_NewArthParser.F90 b/base/MAPL_NewArthParser.F90 index a96787cf15df..72f62579a996 100755 --- a/base/MAPL_NewArthParser.F90 +++ b/base/MAPL_NewArthParser.F90 @@ -132,7 +132,7 @@ subroutine bytecode_dealloc(comp,rc) integer :: status do i=1,comp%StackSize - call ESMF_FieldDestroy(comp%stack(i),noGarbage=.true.,_RC) + call MAPL_FieldDestroy(comp%stack(i),_RC) end do deallocate(comp%stack) deallocate(comp%ByteCode) diff --git a/base/MAPL_TripolarGridFactory.F90 b/base/MAPL_TripolarGridFactory.F90 index 0989cd3d4ed0..d44867b06121 100644 --- a/base/MAPL_TripolarGridFactory.F90 +++ b/base/MAPL_TripolarGridFactory.F90 @@ -488,10 +488,6 @@ subroutine check_and_fill_consistency(this, unusable, rc) end if ! Check decomposition/bounds - ! Tripolar requires even divisibility - _ASSERT(mod(this%im_world, this%nx) == 0,"needs message") - _ASSERT(mod(this%jm_world, this%ny) == 0,"needs message") - ! local extents call verify(this%nx, this%im_world, this%ims, rc=status) call verify(this%ny, this%jm_world, this%jms, rc=status) diff --git a/base/NCIO.F90 b/base/NCIO.F90 index 873ebf6ebf34..acae844fe9ce 100644 --- a/base/NCIO.F90 +++ b/base/NCIO.F90 @@ -40,7 +40,6 @@ module NCIOMod public MAPL_VarRead public MAPL_VarWrite public get_fname_by_face - public MAPL_TileMaskGet public MAPL_NCIOGetFileType public MAPL_VarReadNCPar public MAPL_VarWriteNCPar diff --git a/base/tests/CMakeLists.txt.bak b/base/tests/CMakeLists.txt.bak new file mode 100644 index 000000000000..433c052c70e5 --- /dev/null +++ b/base/tests/CMakeLists.txt.bak @@ -0,0 +1,70 @@ +set(MODULE_DIRECTORY "${esma_include}/MAPL.base/tests") + +add_definitions(-DUSE_MPI) +# uncomment test_mapl_netcdf_private.pf to test private MAPL_NetCDF procedures +# as well as the helper procedures used by test_MAPL_NetCDF and test_MAPL_NetCDF_private +# make sure to make the private procedures in MAPL_NetCDF public (uncomment the 'public' statements). +set (TEST_SRCS + test_Mapl_Base.pf + test_sort.pf +# Test_CFIO_Bundle.pf + Test_SimpleMAPLcomp.pf + Test_StringGridFactoryMap.pf + Test_GridManager.pf + Test_LatLon_GridFactory.pf + Test_SphericalToCartesian.pf + Test_LatLon_Corners.pf + Test_MAPL_Config.pf + test_DirPath.pf + test_TimeStringConversion.pf +# test_MAPL_NetCDF.pf + test_MAPL_NetCDF_helpers.F90 +# test_MAPL_NetCDF_private.pf +# test_MAPL_ISO8601_DateTime_ESMF.pf + ) + +# SRCS are mostly mocks to facilitate tests +set (SRCS + MockGridFactory.F90 + MockRegridder.F90 + ) + +# This file needs to be in a library because CMake cannot detect the +# dependency of the pFUnit driver on it. This is due to the use of +# preprocesor in the driver for specifying the include file. +#add_library (base_extras +# MAPL_Initialize.F90 +# ) +#target_link_libraries (base_extras MAPL.shared MAPL.pfunit +# esmf NetCDF::NetCDF_Fortran) + +add_pfunit_ctest(MAPL.base.tests + TEST_SOURCES ${TEST_SRCS} + OTHER_SOURCES ${SRCS} +# LINK_LIBRARIES MAPL.base MAPL.shared MAPL.pfio base_extras MAPL.pfunit + LINK_LIBRARIES MAPL.base MAPL.shared MAPL.constants MAPL.pfio MAPL.pfunit + EXTRA_INITIALIZE Initialize + EXTRA_USE MAPL_pFUnit_Initialize + MAX_PES 8 + ) +set_target_properties(MAPL.base.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + +add_dependencies(build-tests MAPL.base.tests) + +set(TESTIO mapl_bundleio_test.x) +ecbuild_add_executable ( + TARGET ${TESTIO} + NOINSTALL + SOURCES mapl_bundleio_test.F90 + LIBS MAPL.base MAPL.shared MAPL.constants MAPL.pfio MAPL.griddedio NetCDF::NetCDF_Fortran MPI::MPI_Fortran + DEFINITIONS USE_MPI) +set_target_properties(${TESTIO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + +add_test(NAME bundleio_tests_latlon + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 2 -ny 1 -ogrid PC90x47-DE -o file1_ll.nc4) + +add_test(NAME bundleio_tests_cube + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 6 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 1 -ny 6 -ogrid PE12x72-CF -o file_cs.nc4) + +add_dependencies(build-tests ${TESTIO}) + diff --git a/cmake/FindESMF.cmake b/cmake/FindESMF.cmake new file mode 100644 index 000000000000..161654428d88 --- /dev/null +++ b/cmake/FindESMF.cmake @@ -0,0 +1,138 @@ +# - Try to find ESMF +# +# Uses ESMFMKFILE to find the filepath of esmf.mk. If this is NOT set, then this +# module will attempt to find esmf.mk. If ESMFMKFILE exists, then +# ESMF_FOUND=TRUE and all ESMF makefile variables will be set in the global +# scope. Optionally, set ESMF_MKGLOBALS to a string list to filter makefile +# variables. For example, to globally scope only ESMF_LIBSDIR and ESMF_APPSDIR +# variables, use this CMake command in CMakeLists.txt: +# +# set(ESMF_MKGLOBALS "LIBSDIR" "APPSDIR") + +# Set ESMFMKFILE as defined by system env variable. If it's not explicitly set +# try to find esmf.mk file in default locations (ESMF_ROOT, CMAKE_PREFIX_PATH, +# etc) +if(NOT DEFINED ESMFMKFILE) + if(NOT DEFINED ENV{ESMFMKFILE}) + find_path(ESMFMKFILE_PATH esmf.mk PATH_SUFFIXES lib lib64) + if(ESMFMKFILE_PATH) + set(ESMFMKFILE ${ESMFMKFILE_PATH}/esmf.mk) + message(STATUS "Found esmf.mk file ${ESMFMKFILE}") + endif() + else() + set(ESMFMKFILE $ENV{ESMFMKFILE}) + endif() +endif() + +# Only parse the mk file if it is found +if(EXISTS ${ESMFMKFILE}) + set(ESMFMKFILE ${ESMFMKFILE} CACHE FILEPATH "Path to esmf.mk file") + set(ESMF_FOUND TRUE CACHE BOOL "esmf.mk file found" FORCE) + + # Read the mk file + file(STRINGS "${ESMFMKFILE}" esmfmkfile_contents) + # Parse each line in the mk file + foreach(str ${esmfmkfile_contents}) + # Only consider uncommented lines + string(REGEX MATCH "^[^#]" def ${str}) + # Line is not commented + if(def) + # Extract the variable name + string(REGEX MATCH "^[^=]+" esmf_varname ${str}) + # Extract the variable's value + string(REGEX MATCH "=.+$" esmf_vardef ${str}) + # Only for variables with a defined value + if(esmf_vardef) + # Get rid of the assignment string + string(SUBSTRING ${esmf_vardef} 1 -1 esmf_vardef) + # Remove whitespace + string(STRIP ${esmf_vardef} esmf_vardef) + # A string or single-valued list + if(NOT DEFINED ESMF_MKGLOBALS) + # Set in global scope + set(${esmf_varname} ${esmf_vardef}) + # Don't display by default in GUI + mark_as_advanced(esmf_varname) + else() # Need to filter global promotion + foreach(m ${ESMF_MKGLOBALS}) + string(FIND ${esmf_varname} ${m} match) + # Found the string + if(NOT ${match} EQUAL -1) + # Promote to global scope + set(${esmf_varname} ${esmf_vardef}) + # Don't display by default in the GUI + mark_as_advanced(esmf_varname) + # No need to search for the current string filter + break() + endif() + endforeach() + endif() + endif() + endif() + endforeach() + + # Construct ESMF_VERSION from ESMF_VERSION_STRING_GIT + # ESMF_VERSION_MAJOR and ESMF_VERSION_MINOR are defined in ESMFMKFILE + set(ESMF_VERSION 0) + set(ESMF_VERSION_PATCH ${ESMF_VERSION_REVISION}) + set(ESMF_BETA_RELEASE FALSE) + if(ESMF_VERSION_BETASNAPSHOT MATCHES "^('T')$") + set(ESMF_BETA_RELEASE TRUE) + if(ESMF_VERSION_STRING_GIT MATCHES "^ESMF.*beta_snapshot") + set(ESMF_BETA_SNAPSHOT ${ESMF_VERSION_STRING_GIT}) + elseif(ESMF_VERSION_STRING_GIT MATCHES "^v.\..\..b") + set(ESMF_BETA_SNAPSHOT ${ESMF_VERSION_STRING_GIT}) + else() + set(ESMF_BETA_SNAPSHOT 0) + endif() + message(STATUS "Detected ESMF Beta snapshot: ${ESMF_BETA_SNAPSHOT}") + endif() + set(ESMF_VERSION "${ESMF_VERSION_MAJOR}.${ESMF_VERSION_MINOR}.${ESMF_VERSION_PATCH}") + + # Find the ESMF library + if(USE_ESMF_STATIC_LIBS) + find_library(ESMF_LIBRARY_LOCATION NAMES libesmf.a PATHS ${ESMF_LIBSDIR} NO_DEFAULT_PATH) + if(ESMF_LIBRARY_LOCATION MATCHES "ESMF_LIBRARY_LOCATION-NOTFOUND") + message(WARNING "Static ESMF library (libesmf.a) not found in \ + ${ESMF_LIBSDIR}. Try setting USE_ESMF_STATIC_LIBS=OFF") + endif() + add_library(ESMF STATIC IMPORTED) + else() + find_library(ESMF_LIBRARY_LOCATION NAMES esmf PATHS ${ESMF_LIBSDIR} NO_DEFAULT_PATH) + if(ESMF_LIBRARY_LOCATION MATCHES "ESMF_LIBRARY_LOCATION-NOTFOUND") + message(WARNING "ESMF library not found in ${ESMF_LIBSDIR}.") + endif() + add_library(ESMF UNKNOWN IMPORTED) + endif() + + # Add ESMF include directories + set(ESMF_INCLUDE_DIRECTORIES "") + separate_arguments(_ESMF_F90COMPILEPATHS UNIX_COMMAND ${ESMF_F90COMPILEPATHS}) + foreach(_ITEM ${_ESMF_F90COMPILEPATHS}) + string(REGEX REPLACE "^-I" "" _ITEM "${_ITEM}") + list(APPEND ESMF_INCLUDE_DIRECTORIES ${_ITEM}) + endforeach() + + # Add ESMF link libraries + string(STRIP "${ESMF_F90LINKRPATHS} ${ESMF_F90ESMFLINKRPATHS} ${ESMF_F90ESMFLINKPATHS} ${ESMF_F90LINKPATHS} ${ESMF_F90LINKLIBS} ${ESMF_F90LINKOPTS}" ESMF_INTERFACE_LINK_LIBRARIES) + + # Finalize find_package + include(FindPackageHandleStandardArgs) + + find_package_handle_standard_args( + ${CMAKE_FIND_PACKAGE_NAME} + REQUIRED_VARS ESMF_LIBRARY_LOCATION + ESMF_INTERFACE_LINK_LIBRARIES + ESMF_F90COMPILEPATHS + VERSION_VAR ESMF_VERSION) + + set_target_properties(ESMF PROPERTIES + IMPORTED_LOCATION "${ESMF_LIBRARY_LOCATION}" + INTERFACE_INCLUDE_DIRECTORIES "${ESMF_INCLUDE_DIRECTORIES}" + INTERFACE_LINK_LIBRARIES "${ESMF_INTERFACE_LINK_LIBRARIES}") + +else() + set(ESMF_FOUND FALSE CACHE BOOL "esmf.mk file NOT found" FORCE) + message(WARNING "ESMFMKFILE ${ESMFMKFILE} not found. Try setting ESMFMKFILE \ + to esmf.mk location.") +endif() diff --git a/copy_mapl_netcdf b/copy_mapl_netcdf new file mode 100644 index 000000000000..8b5f0ea0f397 --- /dev/null +++ b/copy_mapl_netcdf @@ -0,0 +1,449 @@ +!wdb todo +!subroutine to convert +!From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] +!To: !ESMF_TIME: with gregorian calendar +!And vice versa. +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +! Procedures to convert from NetCDF datetime to ESMF_Time and ESMF_TimeInterval +! NetCDF datetime is: {integer, character(len=*)} +! {1800, 'seconds since 2010-01-23 18:30:37'} +! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} +module MAPL_NetCDF + + use MAPL_ExceptionHandling + use MAPL_KeywordEnforcerMod + use MAPL_DateTime_Parsing + use ESMF + + implicit none + + public :: convert_NetCDF_DateTime_to_ESMF + public :: convert_ESMF_to_NetCDF_DateTime + + private + public :: make_ESMF_TimeInterval + public :: make_NetCDF_DateTime_int_time + public :: make_NetCDF_DateTime_units_string + public :: convert_ESMF_Time_to_NetCDF_DateTimeString + public :: convert_to_integer + public :: convert_NetCDF_DateTimeString_to_ESMF_Time + public :: is_time_unit + public :: is_valid_netcdf_datetime_string + public :: get_shift_sign + public :: split + public :: split_all + public :: lr_trim + + character, parameter :: PART_DELIM = ' ' + character, parameter :: ISO_DELIM = 'T' + character, parameter :: DATE_DELIM = '-' + character, parameter :: TIME_DELIM = ':' + character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' + character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' + character(len=*), parameter :: NETCDF_DATETIME_FORMAT = NETCDF_DATE // PART_DELIM // NETCDF_TIME + integer, parameter :: LEN_DATE = len(NETCDF_DATE) + integer, parameter :: LEN_TIME = len(NETCDF_TIME) + integer, parameter :: LEN_NETCDF_DATETIME = len(NETCDF_DATETIME_FORMAT) + character(len=*), parameter :: TIME_UNITS(7) = & + [ 'years ', 'months ', 'days ', & + 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] + character, parameter :: SPACE = ' ' + type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN + integer, parameter :: MAX_WIDTH = 10 + integer, parameter :: NUM_PARTS_UNITS_STRING = 4 + +contains + + ! Convert NetCDF_DateTime {int_time, units_string} to + ! ESMF time variables {interval, time0, time1} and time unit {tunit} + ! time0 is the start time, and time1 is time0 + interval + subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & + interval, time0, unusable, time1, tunit, rc) + integer, intent(in) :: int_time + character(len=*), intent(in) :: units_string + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: time0 + class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(inout) :: time1 + character(len=:), allocatable, optional, intent(out) :: tunit + integer, optional, intent(out) :: rc + character(len=:), allocatable :: tunit_ + character(len=len_trim(units_string)) :: parts(2) + character(len=len_trim(units_string)) :: head + character(len=len_trim(units_string)) :: tail + + integer :: span, factor + integer :: status + + _UNUSED_DUMMY(unusable) + + _ASSERT(int_time >= 0, 'Negative span not supported') + _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') + + ! get time unit, tunit + parts = split(lr_trim(units_string), PART_DELIM) + head = parts(1) + tail = parts(2) + tunit_ = lr_trim(head) + _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') + if(present(tunit)) tunit = tunit_ + + ! get span + parts = split(lr_trim(tail), PART_DELIM) + head = parts(1) + tail = parts(2) + + factor = get_shift_sign(head) + _ASSERT(factor /= 0, 'Unrecognized preposition') + span = factor * int_time + + call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) + call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) + + ! get time1 + if(present(time1)) time1 = time0 + interval + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTime_to_ESMF + + ! Convert ESMF time variables to an NetCDF datetime + subroutine convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, unusable, t1, interval, rc) + character(len=*), intent(in) :: tunit + type(ESMF_Time), intent(inout) :: t0 + integer, intent(out) :: int_time + character(len=:), allocatable, intent(out) :: units_string + class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(inout) :: t1 + type(ESMF_TimeInterval), optional, intent(inout) :: interval + integer, optional, intent(out) :: rc + type(ESMF_TimeInterval) :: interval_ + integer :: status + + _UNUSED_DUMMY(unusable) + + if(present(interval)) then + interval_ = interval + elseif(present(t1)) then + interval_ = t1 - t0 + else + _FAIL( 'Only one input argument present') + end if + + call make_NetCDF_DateTime_int_time(interval_, t0, tunit, int_time, _RC) + call make_NetCDF_DateTime_units_string(t0, tunit, units_string, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_ESMF_to_NetCDF_DateTime + + ! Make ESMF_TimeInterval from a span of time, time unit, and start time + subroutine make_ESMF_TimeInterval(span, tunit, t0, interval, unusable, rc) + integer, intent(in) :: span + character(len=*), intent(in) :: tunit + type(ESMF_Time), intent(inout) :: t0 + type(ESMF_TimeInterval), intent(inout) :: interval + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + select case(lr_trim(tunit)) + case('years') + call ESMF_TimeIntervalSet(interval, startTime=t0, yy=span, _RC) + case('months') + call ESMF_TimeIntervalSet(interval, startTime=t0, mm=span, _RC) + case('hours') + call ESMF_TimeIntervalSet(interval, startTime=t0, h=span, _RC) + case('minutes') + call ESMF_TimeIntervalSet(interval, startTime=t0, m=span, _RC) + case('seconds') + call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_ESMF_TimeInterval + + ! Get time span from NetCDF datetime + subroutine make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, unusable, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: t0 + character(len=*), intent(in) :: tunit + integer, intent(out) :: int_time + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + + _UNUSED_DUMMY(unusable) + + ! get int_time + select case(lr_trim(tunit)) + case('years') + call ESMF_TimeIntervalGet(interval, t0, yy=int_time, _RC) + case('months') + call ESMF_TimeIntervalGet(interval, t0, mm=int_time, _RC) + case('hours') + call ESMF_TimeIntervalGet(interval, t0, h=int_time, _RC) + case('minutes') + call ESMF_TimeIntervalGet(interval, t0, m=int_time, _RC) + case('seconds') + call ESMF_TimeIntervalGet(interval, t0, s=int_time, _RC) + case default + _FAIL('Unrecognized unit') + end select + + _RETURN(_SUCCESS) + + end subroutine make_NetCDF_DateTime_int_time + + ! Make 'units' for NetCDF datetime + subroutine make_NetCDF_DateTime_units_string(t0, tunit, units_string, unusable, rc) + type(ESMF_Time), intent(inout) :: t0 + character(len=*), intent(in) :: tunit + character(len=:), allocatable, intent(out) :: units_string + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + character(len=*), parameter :: preposition = 'since' + character(len=:), allocatable :: datetime_string + integer :: status + + _UNUSED_DUMMY(unusable) + + ! make units_string + call convert_ESMF_Time_to_NetCDF_DateTimeString(t0, datetime_string, _RC) + units_string = tunit //SPACE// preposition //SPACE// datetime_string + + _RETURN(_SUCCESS) + + end subroutine make_NetCDF_DateTime_units_string + + ! Convert ESMF_Time to a NetCDF datetime string (start datetime) + subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_string, unusable, rc) + type(ESMF_Time), intent(inout) :: esmf_datetime + character(len=:), allocatable, intent(out) :: datetime_string + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + character(len=*), parameter :: ERR_PRE = 'Failed to write string: ' + integer :: yy, mm, dd, h, m, s + character(len=10) :: FMT + character(len=4) :: yy_string + character(len=2) :: mm_string + character(len=2) :: dd_string + character(len=2) :: h_string + character(len=2) :: m_string + character(len=2) :: s_string + character(len=LEN_NETCDF_DATETIME) :: tmp_string + integer :: status, iostatus + + _UNUSED_DUMMY(unusable) + + call ESMF_TimeGet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + + FMT='(BZ, I2.2)' + write(s_string, fmt=FMT, iostat=iostatus) s + _ASSERT(iostatus == 0, ERR_PRE // 'second') + write(m_string, fmt=FMT, iostat=iostatus) m + _ASSERT(iostatus == 0, ERR_PRE // 'minute') + write(h_string, fmt=FMT, iostat=iostatus) h + _ASSERT(iostatus == 0, ERR_PRE // 'hour') + write(dd_string, fmt=FMT, iostat=iostatus) dd + _ASSERT(iostatus == 0, ERR_PRE // 'day') + write(mm_string, fmt=FMT, iostat=iostatus) mm + _ASSERT(iostatus == 0, ERR_PRE // 'month') + FMT='(BZ, I4.4)' + write(yy_string, fmt=FMT, iostat=iostatus) yy + _ASSERT(iostatus == 0, ERR_PRE // 'year') + + tmp_string = yy_string // DATE_DELIM // mm_string // DATE_DELIM // dd_string // PART_DELIM // & + h_string // TIME_DELIM // m_string // TIME_DELIM // s_string + + datetime_string = tmp_string + + _RETURN(_SUCCESS) + + end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString + + ! Convert string representing an integer to the integer + subroutine convert_to_integer(string_in, int_out, rc) + character(len=*), intent(in) :: string_in + integer, intent(out) :: int_out + integer, optional, intent(out) :: rc + integer :: stat + + read(string_in, '(I16)', iostat=stat) int_out + + if(present(rc)) rc = stat + + end subroutine convert_to_integer + + ! Convert NetCDF datetime to ESMF_Time + subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) + character(len=*), intent(in) :: datetime_string + type(ESMF_Time), intent(inout) :: datetime + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status + integer :: yy, mm, dd, h, m, s, i, j + character(len=4) :: part + + _UNUSED_DUMMY(unusable) + + _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') + + i = 1 + j = i + 3 + part = datetime_string(i:j) + call convert_to_integer(part, yy, rc = status) + _ASSERT(status == 0, 'Unable to convert year string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, mm, rc = status) + _ASSERT(status == 0, 'Unable to convert month string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, dd, rc = status) + _ASSERT(status == 0, 'Unable to convert day string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, h, rc = status) + _ASSERT(status == 0, 'Unable to convert hour string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, m, rc = status) + _ASSERT(status == 0, 'Unable to convert minute string') + + i = j + 2 + j = j + 3 + part = datetime_string(i:j) + call convert_to_integer(part, s, rc = status) + _ASSERT(status == 0, 'Unable to convert second string') + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time + + function is_valid_netcdf_datetime_string(string) result(tval) + character(len=*), parameter :: DIGITS = '0123456789' + character(len=*), intent(in) :: string + logical :: tval + integer :: i + + tval = .false. + + if(len(string) /= len(NETCDF_DATETIME_FORMAT)) return + + do i=1, len(string) + if(scan(NETCDF_DATETIME_FORMAT(i:i), DIGITS) > 0) then + if(scan(string(i:i), DIGITS) <= 0) return + else + if(string(i:i) /= NETCDF_DATETIME_FORMAT(i:i)) return + end if + end do + + tval = .true. + + end function is_valid_netcdf_datetime_string + + function is_time_unit(tunit) + character(len=*), intent(in) :: tunit + logical :: is_time_unit + integer :: i + + is_time_unit = .TRUE. + do i = 1, size(TIME_UNITS) + if(lr_trim(tunit) == lr_trim(TIME_UNITS(i))) return + end do + is_time_unit = .FALSE. + + end function is_time_unit + + function lr_trim(string) + character(len=*), intent(in) :: string + character(len=:), allocatable :: lr_trim + + lr_trim = trim(adjustl(string)) + + end function lr_trim + + ! Get the sign of integer represening a time span based on preposition + function get_shift_sign(preposition) + character(len=*), intent(in) :: preposition + integer :: get_shift_sign + integer, parameter :: POSITIVE = 1 + get_shift_sign = 0 + if(lr_trim(preposition) == 'since') get_shift_sign = POSITIVE + end function get_shift_sign + + ! Split string at delimiter + function split(string, delimiter) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: delimiter + character(len=len(string)) :: split(2) + integer start + + split = ['', ''] + split(1) = string + start = index(string, delimiter) + if(start < 1) return + split(1) = string(1:(start - 1)) + split(2) = string((start+len(delimiter)):len(string)) + end function split + + ! Split string into all substrings based on delimiter + recursive function split_all(string, delimiter) result(parts) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: delimiter + character(len=:), allocatable :: parts(:) + integer :: start + + start = index(string, delimiter) + + if(start == 0) then + parts = [string] + else + parts = [string(1:(start-1)), split_all(string((start+len(delimiter)):len(string)), delimiter)] + end if + + end function split_all + + subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(span, units_string, & + time, unusable, rc) + + integer, intent(in) :: span + character(len=*), intent(in) :: units_string + type(ESMF_Time), optional, intent(inout) :: time + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ESMF_TimeInterval), :: interval + type(ESMF_Time) :: time0 + character(len=:), allocatable :: tunit + character(len=:), allocatable :: parts(:) + character(len=:), allocatable :: head + character(len=:), allocatable :: tail + integer :: span, factor + integer :: status + + _UNUSED_DUMMY(unusable) + + _ASSERT(span >= 0, 'Negative span not supported') + _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') + + parts = split_all(units_string, PART_DELIM) +end module MAPL_NetCDF diff --git a/geom/FieldPointerUtilities.F90 b/geom/FieldPointerUtilities.F90 index 5cc056cc5720..aa6cdddd3a11 100644 --- a/geom/FieldPointerUtilities.F90 +++ b/geom/FieldPointerUtilities.F90 @@ -19,6 +19,7 @@ module MAPL_FieldPointerUtilities public :: FieldsAreBroadcastConformable public :: FieldsAreSameTypeKind public :: FieldCopy + public :: MAPL_FieldDestroy public :: FieldCopyBroadcast interface GetFieldsUndef @@ -74,6 +75,10 @@ module MAPL_FieldPointerUtilities interface FieldCopyBroadcast procedure copy_broadcast end interface FieldCopyBroadcast + + interface MAPL_FieldDestroy + procedure destroy + end interface contains @@ -373,21 +378,56 @@ subroutine clone(x, y, rc) character(len=ESMF_MAXSTR) :: name integer :: status integer :: field_rank, grid_rank,ungrid_size + type(ESMF_Index_Flag) :: index_flag + real(kind=ESMF_KIND_R4), pointer :: VR4_1D(:), VR4_2D(:,:), VR4_3D(:,:,:), VR4_4D(:,:,:,:) + real(kind=ESMF_KIND_R8), pointer :: VR8_1D(:), VR8_2D(:,:), VR8_3D(:,:,:), VR8_4D(:,:,:,:) + integer, allocatable :: lc(:) call ESMF_FieldGet(x,grid=grid,rank=field_rank,_RC) - call ESMF_GridGet(grid,dimCount=grid_rank,_RC) + lc = get_local_element_count(x,_RC) + call ESMF_GridGet(grid,dimCount=grid_rank,indexFlag=index_flag,_RC) ungrid_size = field_rank-grid_rank allocate(gridToFieldMap(grid_rank)) allocate(ungriddedLBound(ungrid_size),ungriddedUBound(ungrid_size)) call ESMF_FieldGet(x, typekind=tk, name = name, & staggerloc=staggerloc, gridToFieldMap=gridToFieldMap, & - ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, _RC) + ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, _RC) name = trim(name) // CLONE_TAG - y = ESMF_FieldCreate(grid, typekind=tk, staggerloc=staggerloc, & - gridToFieldMap=gridToFieldMap, ungriddedLBound=ungriddedLBound, & - ungriddedUBound=ungriddedUBound, name=name, _RC) + if (index_flag == ESMF_INDEX_USER) then + if (tk == ESMF_TYPEKIND_R4 .and. field_rank == 1) then + allocate(VR4_1d(lc(1)),_STAT) + y = ESMF_FieldCreate(grid,VR4_1d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R8 .and. field_rank == 1) then + allocate(VR8_1d(lc(1)),_STAT) + y = ESMF_FieldCreate(grid,VR8_1d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R4 .and. field_rank == 2) then + allocate(VR4_2d(lc(1),lc(2)),_STAT) + y = ESMF_FieldCreate(grid,VR4_2d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R8 .and. field_rank == 2) then + allocate(VR8_2d(lc(1),lc(2)),_STAT) + y = ESMF_FieldCreate(grid,VR8_2d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R4 .and. field_rank == 3) then + allocate(VR4_3d(lc(1),lc(2),lc(3)),_STAT) + y = ESMF_FieldCreate(grid,VR4_3d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R8 .and. field_rank == 3) then + allocate(VR8_3d(lc(1),lc(2),lc(3)),_STAT) + y = ESMF_FieldCreate(grid,VR8_3d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R4 .and. field_rank == 4) then + allocate(VR4_4d(lc(1),lc(2),lc(3),lc(4)),_STAT) + y = ESMF_FieldCreate(grid,VR4_4d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else if (tk == ESMF_TYPEKIND_R8 .and. field_rank == 4) then + allocate(VR8_4d(lc(1),lc(2),lc(3),lc(4)),_STAT) + y = ESMF_FieldCreate(grid,VR8_4d,gridToFieldMap=gridToFieldMap,name=name,_RC) + else + _FAIL( 'unsupported typekind+field_rank') + end if + else + y = ESMF_FieldCreate(grid, tk, staggerloc=staggerloc, & + gridToFieldMap=gridToFieldMap, ungriddedLBound=ungriddedLBound, & + ungriddedUBound=ungriddedUBound, name=name, _RC) + end if _RETURN(_SUCCESS) end subroutine clone @@ -859,4 +899,51 @@ subroutine GetFieldsUndef_r8(fields,undef_values,rc) _RETURN(_SUCCESS) end subroutine GetFieldsUndef_r8 +subroutine Destroy(Field,RC) + type(ESMF_Field), intent(INOUT) :: Field + integer, optional, intent(OUT ) :: RC + + integer :: STATUS + + real(kind=ESMF_KIND_R4), pointer :: VR4_1D(:), VR4_2D(:,:), VR4_3D(:,:,:), VR4_4D(:,:,:,:) + real(kind=ESMF_KIND_R8), pointer :: VR8_1D(:), VR8_2D(:,:), VR8_3D(:,:,:), VR8_4D(:,:,:,:) + integer :: rank + type(ESMF_TypeKind_Flag) :: tk + logical :: esmf_allocated + + call ESMF_FieldGet(Field,typekind=tk,dimCount=rank,isESMFAllocated=esmf_allocated,_RC) + if (.not. esmf_allocated) then + if (tk == ESMF_TYPEKIND_R4 .and. rank == 1) then + call ESMF_FieldGet(Field,0,VR4_1d,_RC) + deallocate(VR4_1d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 1) then + call ESMF_FieldGet(Field,0,VR8_1d,_RC) + deallocate(VR8_1d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 2) then + call ESMF_FieldGet(Field,0,VR4_2d,_RC) + deallocate(VR4_2d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 2) then + call ESMF_FieldGet(Field,0,VR8_2d,_RC) + deallocate(VR8_2d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 3) then + call ESMF_FieldGet(Field,0,VR4_3D,_RC) + deallocate(VR4_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 3) then + call ESMF_FieldGet(Field,0,VR8_3D,_RC) + deallocate(VR8_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 4) then + call ESMF_FieldGet(Field,0,VR4_4D,_RC) + deallocate(VR4_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 4) then + call ESMF_FieldGet(Field,0,VR8_4D,_RC) + deallocate(VR8_3d,_STAT) + else + _FAIL( 'unsupported typekind+rank') + end if + end if + call ESMF_FieldDestroy(Field,noGarbage = .true., rc=status) + _VERIFY(STATUS) + _RETURN(ESMF_SUCCESS) + + end subroutine Destroy end module diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 438107c6a54a..dbb2640df122 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -271,15 +271,32 @@ subroutine run_model(this, comm, unusable, rc) integer, optional, intent(out) ::rc integer(kind=INT64) :: start_tick, stop_tick, tick_rate + integer :: rank, ierror integer :: status class(Logger), pointer :: lgr + logical :: file_exists _UNUSED_DUMMY(unusable) call start_timer() - call ESMF_Initialize (logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=comm, rc=status) - _VERIFY(status) + ! Look for a file called "ESMF.rc" but we want to do this on root and then + ! broadcast the result to the other ranks + + call MPI_COMM_RANK(comm, rank, ierror) + + if (rank == 0) then + inquire(file='ESMF.rc', exist=file_exists) + end if + call MPI_BCAST(file_exists, 1, MPI_LOGICAL, 0, comm, ierror) + + ! If the file exists, we pass it into ESMF_Initialize, else, we + ! use the one from the command line arguments + if (file_exists) then + call ESMF_Initialize (configFileName='ESMF.rc', mpiCommunicator=comm, _RC) + else + call ESMF_Initialize (logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=comm, _RC) + end if ! Note per ESMF this is a temporary routine as eventually MOAB will ! be the only mesh generator. But until then, this allows us to diff --git a/gridcomps/ExtData2G/ExtDataBracket.F90 b/gridcomps/ExtData2G/ExtDataBracket.F90 index f6fd5dc964f9..9ef4fd590362 100644 --- a/gridcomps/ExtData2G/ExtDataBracket.F90 +++ b/gridcomps/ExtData2G/ExtDataBracket.F90 @@ -8,6 +8,7 @@ module MAPL_ExtDataBracket use MAPL_ExtDataNode use MAPL_ExtDataConstants use MAPL_CommsMod + use MAPL_Geom implicit none private @@ -41,7 +42,7 @@ subroutine reset(this) this%new_file_right=.false. this%new_file_left =.false. end subroutine reset - +! function time_in_bracket(this,time) result(in_bracket) class(ExtDataBracket), intent(in) :: this logical :: in_bracket @@ -178,13 +179,9 @@ subroutine interpolate_to_time(this,field,time,rc) type(ESMF_TimeInterval) :: tinv1, tinv2 real :: alpha - real, pointer :: var2d(:,:) => null() - real, pointer :: var3d(:,:,:) => null() - real, pointer :: var2d_left(:,:) => null() - real, pointer :: var2d_right(:,:) => null() - real, pointer :: var3d_left(:,:,:) => null() - real, pointer :: var3d_right(:,:,:) => null() - integer :: field_rank + real, pointer :: var1d(:) => null() + real, pointer :: var1d_left(:) => null() + real, pointer :: var1d_right(:) => null() integer :: status logical :: right_node_set, left_node_set character(len=ESMF_MAXPATHLEN) :: left_file, right_file @@ -196,81 +193,41 @@ subroutine interpolate_to_time(this,field,time,rc) right_node_set = right_file /= file_not_found left_node_set = left_file /= file_not_found - - call ESMF_FieldGet(field,dimCount=field_rank,_RC) alpha = 0.0 if ( (.not.this%disable_interpolation) .and. (.not.this%intermittent_disable) .and. right_node_set .and. left_node_set) then tinv1 = time - this%left_node%time tinv2 = this%right_node%time - this%left_node%time alpha = tinv1/tinv2 end if - if (field_rank==2) then - - call esmf_fieldget(field,localde=0,farrayptr=var2d,_RC) - if (right_node_set) then - call esmf_fieldget(this%right_node%field,localde=0,farrayptr=var2d_right,_RC) - end if - if (left_node_set) then - call esmf_fieldget(this%left_node%field,localde=0,farrayptr=var2d_left,_RC) - end if - if ( left_node_set .and. (time == this%left_node%time .or. this%disable_interpolation)) then - var2d = var2d_left - else if (right_node_set .and. (time == this%right_node%time)) then - var2d = var2d_right - else if ( (left_node_set .and. right_node_set) .and. (.not.this%exact) ) then - where( (var2d_left /= mapl_undef) .and. (var2d_right /= mapl_undef)) - var2d = var2d_left + alpha*(var2d_right-var2d_left) - elsewhere - var2d = mapl_undef - endwhere - else - var2d = mapl_undef - end if - - if (this%scale_factor == 0.0 .and. this%offset /= 0.0) then - where(var2d /= MAPL_UNDEF) var2d=var2d+this%offset - end if - if (this%scale_factor /= 0.0 .and. this%offset == 0.0) then - where(var2d /= MAPL_UNDEF) var2d=var2d*this%scale_factor - end if - if (this%scale_factor /= 0.0 .and. this%offset /= 0.0) then - where(var2d /= MAPL_UNDEF) var2d=var2d*this%scale_factor+this%offset - end if - - else if (field_rank==3) then - call esmf_fieldget(field,localde=0,farrayptr=var3d,_RC) - if (right_node_set) then - call esmf_fieldget(this%right_node%field,localde=0,farrayptr=var3d_right,_RC) - end if - if (left_node_set) then - call esmf_fieldget(this%left_node%field,localde=0,farrayptr=var3d_left,_RC) - end if - if ( left_node_set .and. (time == this%left_node%time .or. this%disable_interpolation) ) then - var3d = var3d_left - else if ( right_node_set .and. (time == this%right_node%time) ) then - var3d = var3d_right - else if (right_node_set .and. (time == this%right_node%time)) then - var3d = var3d_right - else if ( (left_node_set .and. right_node_set) .and. (.not.this%exact) )then - where( (var3d_left /= mapl_undef) .and. (var3d_right /= mapl_undef)) - var3d = var3d_left + alpha*(var3d_right-var3d_left) - elsewhere - var3d = mapl_undef - endwhere - else - var3d = mapl_undef - end if - - if (this%scale_factor == 0.0 .and. this%offset /= 0.0) then - where(var3d /= MAPL_UNDEF) var3d=var3d+this%offset - end if - if (this%scale_factor /= 0.0 .and. this%offset == 0.0) then - where(var3d /= MAPL_UNDEF) var3d=var3d*this%scale_factor - end if - if (this%scale_factor /= 0.0 .and. this%offset /= 0.0) then - where(var3d /= MAPL_UNDEF) var3d=var3d*this%scale_factor+this%offset - end if + call assign_fptr(field,var1d,_RC) + if (right_node_set) then + call assign_fptr(this%right_node%field,var1d_right,_RC) + end if + if (left_node_set) then + call assign_fptr(this%left_node%field,var1d_left,_RC) + end if + if ( left_node_set .and. (time == this%left_node%time .or. this%disable_interpolation)) then + var1d = var1d_left + else if (right_node_set .and. (time == this%right_node%time)) then + var1d = var1d_right + else if ( (left_node_set .and. right_node_set) .and. (.not.this%exact) ) then + where( (var1d_left /= mapl_undef) .and. (var1d_right /= mapl_undef)) + var1d = var1d_left + alpha*(var1d_right-var1d_left) + elsewhere + var1d = mapl_undef + endwhere + else + var1d = mapl_undef + end if + if (this%scale_factor == 0.0 .and. this%offset /= 0.0) then + where(var1d /= MAPL_UNDEF) var1d=var1d+this%offset + end if + if (this%scale_factor /= 0.0 .and. this%offset == 0.0) then + where(var1d /= MAPL_UNDEF) var1d=var1d*this%scale_factor + end if + if (this%scale_factor /= 0.0 .and. this%offset /= 0.0) then + where(var1d /= MAPL_UNDEF) var1d=var1d*this%scale_factor+this%offset end if _RETURN(_SUCCESS) @@ -281,24 +238,15 @@ subroutine swap_node_fields(this,rc) class(ExtDataBracket), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status - integer :: field_rank - real, pointer :: var3d_left(:,:,:),var3d_right(:,:,:) - real, pointer :: var2d_left(:,:),var2d_right(:,:) + real, pointer :: left_ptr(:), right_ptr(:) logical :: left_created, right_created left_created = ESMF_FieldIsCreated(this%left_node%field,_RC) right_created = ESMF_FieldIsCreated(this%right_node%field,_RC) if (left_created .and. right_created) then - call ESMF_FieldGet(this%left_node%field,dimCount=field_rank,_RC) - if (field_rank == 2) then - call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var2d_right,_RC) - call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var2d_left,_RC) - var2d_left = var2d_right - else if (field_rank ==3) then - call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var3d_right,_RC) - call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var3d_left,_RC) - var3d_left = var3d_right - end if + call assign_fptr(this%left_node%field,left_ptr,_RC) + call assign_fptr(this%right_node%field,right_ptr,_RC) + left_ptr = right_ptr end if _RETURN(_SUCCESS) end subroutine swap_node_fields diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 3272e8a1092c..957f6d7cc02a 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -61,6 +61,7 @@ MODULE MAPL_ExtDataGridComp2G use pflogger, only: logging, Logger use MAPL_ExtDataLogger use MAPL_ExtDataConstants + use gFTL_StringIntegerMap IMPLICIT NONE PRIVATE @@ -1346,7 +1347,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() - call io_bundle%make_cfio(_RC) + call io_bundle%make_io(_RC) call bundle_iter%next() enddo @@ -1386,8 +1387,11 @@ subroutine MAPL_ExtDataPrefetch(IOBundles,rc) do n = 1, nfiles io_bundle => IOBundles%at(n) - call io_bundle%cfio%request_data_from_file(io_bundle%file_name,io_bundle%time_index,rc=status) - _VERIFY(status) + if (io_bundle%on_tiles) then + call io_bundle%tile_io%request_data_from_file(io_bundle%file_name,io_bundle%time_index,_RC) + else + call io_bundle%grid_io%request_data_from_file(io_bundle%file_name,io_bundle%time_index,_RC) + end if enddo _RETURN(ESMF_SUCCESS) @@ -1406,8 +1410,11 @@ subroutine MAPL_ExtDataReadPrefetch(IOBundles,rc) nfiles = IOBundles%size() do n=1, nfiles io_bundle => IOBundles%at(n) - call io_bundle%cfio%process_data_from_file(rc=status) - _VERIFY(status) + if (io_bundle%on_tiles) then + call io_bundle%tile_io%process_data_from_file(_RC) + else + call io_bundle%grid_io%process_data_from_file(_RC) + end if enddo _RETURN(ESMF_SUCCESS) @@ -1453,13 +1460,19 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) logical :: update character(len=ESMF_MAXPATHLEN) :: current_file integer :: time_index + type(StringIntegerMap), pointer :: dimensions + integer, pointer :: tile_size + logical :: on_tiles + dimensions => item%file_metadata%get_dimensions() + tile_size => dimensions%at("tile_index") + on_tiles = associated(tile_size) call item%modelGridFields%comp1%get_parameters('L',update=update,file=current_file,time_index=time_index) if (update) then if (trim(current_file)/=file_not_found) then call itemsL%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsL,rc=status) + item%pfioCollection_id,item%iclient_collection_id,itemsL,on_tiles,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated L bracket with: %a at time index %i3 ',item%name, current_file, time_index) @@ -1470,7 +1483,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) if (trim(current_file)/=file_not_found) then call itemsR%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,itemsR,rc=status) + item%pfioCollection_id,item%iclient_collection_id,itemsR,on_tiles,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated R bracket with: %a at time index %i3 ',item%name,current_file, time_index) diff --git a/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 index 1e116ee47a8d..eda391c11d01 100644 --- a/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 +++ b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 @@ -10,6 +10,7 @@ module MAPL_ExtDataNG_IOBundleMod use ESMF use MAPL_BaseMod use MAPL_GriddedIOMod + use MAPL_TileIOMod use MAPL_ExceptionHandling use MAPL_GriddedIOItemMod use MAPL_GriddedIOItemVectorMod @@ -17,7 +18,8 @@ module MAPL_ExtDataNG_IOBundleMod public :: ExtDataNG_IOBundle type ExtDataNG_IOBundle - type (MAPL_GriddedIO) :: cfio + type (MAPL_GriddedIO) :: grid_io + type (MAPL_TileIO) :: tile_io type (ESMF_FieldBundle) :: pbundle character(:), allocatable :: template integer :: regrid_method @@ -30,11 +32,12 @@ module MAPL_ExtDataNG_IOBundleMod integer :: metadata_coll_id integer :: server_coll_id type(GriddedIOItemVector) :: items + logical :: on_tiles contains procedure :: clean - procedure :: make_cfio + procedure :: make_io procedure :: assign generic :: assignment(=) => assign end type ExtDataNG_IOBundle @@ -46,7 +49,7 @@ module MAPL_ExtDataNG_IOBundleMod contains - function new_ExtDataNG_IOBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items,rc) result(io_bundle) + function new_ExtDataNG_IOBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items, on_tiles, rc) result(io_bundle) type (ExtDataNG_IOBundle) :: io_bundle integer, intent(in) :: bracket_side @@ -59,6 +62,7 @@ function new_ExtDataNG_IOBundle(bracket_side, entry_index, file_name, time_index integer, intent(in) :: metadata_coll_id integer, intent(in) :: server_coll_id type(GriddedIOItemVector) :: items + logical, intent(in) :: on_tiles integer, optional, intent(out) :: rc io_bundle%bracket_side = bracket_side @@ -72,6 +76,7 @@ function new_ExtDataNG_IOBundle(bracket_side, entry_index, file_name, time_index io_bundle%metadata_coll_id=metadata_coll_id io_bundle%server_coll_id=server_coll_id io_bundle%items=items + io_bundle%on_tiles = on_tiles _RETURN(ESMF_SUCCESS) end function new_ExtDataNG_IOBundle @@ -90,18 +95,22 @@ subroutine clean(this, rc) end subroutine clean - subroutine make_cfio(this, rc) + subroutine make_io(this, rc) class (ExtDataNG_IOBundle), intent(inout) :: this integer, optional, intent(out) :: rc - this%cfio = MAPL_GriddedIO(output_bundle=this%pbundle,regrid_method=this%regrid_method, & - read_collection_id=this%server_coll_id, & - metadata_collection_id = this%metadata_coll_id, fraction = this%fraction, & - items=this%items) + if (this%on_tiles) then + this%tile_io = MAPL_TileIO(this%pbundle,this%server_coll_id) + else + this%grid_io = MAPL_GriddedIO(output_bundle=this%pbundle,regrid_method=this%regrid_method, & + read_collection_id=this%server_coll_id, & + metadata_collection_id = this%metadata_coll_id, fraction = this%fraction, & + items=this%items) + end if _RETURN(ESMF_SUCCESS) - end subroutine make_cfio + end subroutine make_io subroutine assign(to,from) class(ExtDataNG_IOBundle), intent(out) :: to @@ -119,7 +128,9 @@ subroutine assign(to,from) to%server_coll_id=from%server_coll_id to%items=from%items to%pbundle=from%pbundle - to%CFIO=from%CFIO + to%grid_io=from%grid_io + to%tile_io=from%tile_io + to%on_tiles=from%on_tiles end subroutine assign diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 5704080a8b81..a01c4bc22200 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -2440,6 +2440,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) print *, ' End_Date: ', list(n)%end_date print *, ' End_Time: ', list(n)%end_time endif + print *, ' Regrid Mthd: ', regrid_method_int_to_string(list(n)%regrid_method) block integer :: im_world, jm_world,dims(3) diff --git a/griddedio/CMakeLists.txt b/griddedio/CMakeLists.txt index a34c6fdab1c0..1721226ab822 100644 --- a/griddedio/CMakeLists.txt +++ b/griddedio/CMakeLists.txt @@ -7,6 +7,7 @@ set (srcs GriddedIO.F90 FieldBundleRead.F90 FieldBundleWrite.F90 + TileIO.F90 ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.pfio diff --git a/griddedio/DataCollection.F90 b/griddedio/DataCollection.F90 index 9dd092e7ad10..c881a4f8bd04 100644 --- a/griddedio/DataCollection.F90 +++ b/griddedio/DataCollection.F90 @@ -61,6 +61,9 @@ function find(this, file_name, rc) result(metadata) type (StringIntegerMapIterator) :: iter class (AbstractGridFactory), allocatable :: factory integer :: status + type(StringIntegerMap), pointer :: dimensions + integer, pointer :: tile_size + logical :: skip_grid file_id => this%file_ids%at(file_name) @@ -103,7 +106,11 @@ function find(this, file_name, rc) result(metadata) call this%metadatas%push_back(metadata) deallocate(metadata) metadata => this%metadatas%back() - if (.not. allocated(this%src_grid)) then + dimensions => metadata%get_dimensions() + tile_size => dimensions%at("tile_index") + skip_grid = associated(tile_size) + + if ( (.not. allocated(this%src_grid)) .and. (.not. skip_grid)) then allocate(factory, source=grid_manager%make_factory(trim(file_name),force_file_coordinates=this%use_file_coords)) this%src_grid = grid_manager%make_grid(factory) end if diff --git a/griddedio/TileIO.F90 b/griddedio/TileIO.F90 new file mode 100644 index 000000000000..7b55aca9609c --- /dev/null +++ b/griddedio/TileIO.F90 @@ -0,0 +1,121 @@ +#include "MAPL_Generic.h" + +module MAPL_TileIOMod + use ESMF + use pFIO + use MAPL_BaseMod + use MAPL_ExceptionHandling + use MAPL_CommsMod + use FIleIOSharedMod, only: MAPL_TileMaskGet + + implicit none + + private + + type, public :: MAPL_TileIO + private + type(ESMF_FieldBundle) :: bundle + integer :: read_collection_id + type(tile_buffer), allocatable :: tile_buffer(:) + contains + procedure :: request_data_from_file + procedure :: process_data_from_file + end type MAPL_TileIO + + type tile_buffer + real, allocatable :: ptr(:) + end type + + interface MAPL_TileIO + module procedure new_MAPL_TileIO + end interface MAPL_TileIO + + contains + + function new_MAPL_TileIO(bundle,read_collection_id) result(TileIO) + type(MAPL_TileIO) :: TileIO + type(ESMF_FieldBundle),intent(in) :: bundle + integer, intent(in) :: read_collection_id + + TileIO%bundle = bundle + TileIO%read_collection_id = read_collection_id + end function + + subroutine request_data_from_file(this,filename,timeindex,rc) + class(MAPL_TileIO), intent(inout) :: this + character(len=*), intent(in) :: filename + integer, intent(in) :: timeindex + integer, intent(out), optional :: rc + + integer :: status + integer :: num_vars,i,rank + type(ArrayReference) :: ref + character(len=ESMF_MAXSTR), allocatable :: names(:) + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid + integer :: counts(3) + integer, allocatable :: local_start(:), global_start(:), global_count(:) + + + call ESMF_FieldBundleGet(this%bundle, fieldCount=num_vars, _RC) + allocate(this%tile_buffer(num_vars)) + allocate(names(num_vars)) + call ESMF_FieldBundleGet(this%bundle, fieldNameList=names, _RC) + do i=1,num_vars + call ESMF_FieldBundleGet(this%bundle,names(i),field=field,_RC) + call ESMF_FieldGet(field,rank=rank,grid=grid,_RC) + call MAPL_GridGet(grid,globalCellCountPerDim=counts,_RC) + if (rank==1) then + allocate(local_start(2),global_start(2),global_count(2)) + local_start = [1,timeindex] + global_start = [1,timeindex] + global_count = [counts(1),1] + if (mapl_am_I_root()) then + allocate(this%tile_buffer(i)%ptr(counts(1)),_STAT) + else + allocate(this%tile_buffer(i)%ptr((0)),_STAT) + end if + ref = ArrayReference(this%tile_buffer(i)%ptr) + call i_clients%collective_prefetch_data(this%read_collection_id, filename, trim(names(i)), ref, & + start=local_start, global_start=global_start, global_count = global_count) + deallocate(local_start,global_start,global_count) + else + _FAIL("rank >1 tile fields not supported") + end if + end do + + _RETURN(_SUCCESS) + end subroutine + + subroutine process_data_from_file(this,rc) + class(MAPL_TileIO), intent(inout) :: this + integer, intent(out), optional :: rc + + integer :: status + integer :: i,num_vars,rank + type(ESMF_Field) :: field + character(len=ESMF_MAXSTR), allocatable :: names(:) + type(ESMF_Grid) :: grid + integer, pointer :: mask(:) + real, pointer :: ptr1d(:) + + call ESMF_FieldBundleGet(this%bundle, fieldCount=num_vars, _RC) + allocate(names(num_vars)) + call ESMF_FieldBundleGet(this%bundle, fieldNameList=names, _RC) + do i=1,num_vars + call ESMF_FieldBundleGet(this%bundle,names(i),field=field,_RC) + call ESMF_FieldGet(field,rank=rank,grid=grid,_RC) + call MAPL_TileMaskGet(grid,mask,_RC) + if (rank==1) then + call ESMF_FieldGet(field,localDE=0,farrayPtr=ptr1d,_RC) + call ArrayScatter(ptr1d,this%tile_buffer(i)%ptr,grid,mask=mask,_RC) + deallocate(this%tile_buffer(i)%ptr) + else + _FAIL("rank not supported for tile io") + end if + enddo + deallocate(this%tile_buffer) + _RETURN(_SUCCESS) + end subroutine + +end module diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index 01f0ff3c8137..7de858a3edc6 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -118,7 +118,7 @@ if (BUILD_WITH_PFLOGGER) endif () esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL_SHARED::gftl-shared PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran) +target_link_libraries (${this} PUBLIC GFTL::gftl-v2 GFTL_SHARED::gftl-shared-v2 PFLOGGER::pflogger PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index 32798edbe21c..bc2220dccaf0 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -46,6 +46,7 @@ module pFIO_MultiGroupServerMod use pFIO_AbstractRequestHandleMod use pFIO_FileMetadataMod use pFIO_IntegerMessageMapMod + use gFTL2_StringSet, StringSetIterator =>SetIterator use mpi use pFlogger, only: logging, Logger @@ -87,6 +88,8 @@ module pFIO_MultiGroupServerMod module procedure new_MultiGroupServer end interface MultiGroupServer + integer, parameter :: FNAME_LEN = 512 + contains function new_MultiGroupServer(server_comm, port_name, nwriter_per_node, with_profiler, rc) result(s) @@ -335,6 +338,7 @@ subroutine receive_output_data(this, rc) type (HistoryCollection), pointer :: hist_collection integer, pointer :: i_ptr(:) class (AbstractRequestHandle), pointer :: handle + character(len=FNAME_LEN) :: FileName if (associated(ioserver_profiler)) call ioserver_profiler%start("receive_data") client_num = this%threads%size() @@ -395,6 +399,15 @@ subroutine receive_output_data(this, rc) if (this%I_am_front_root) then collection_id = collection_ids%at(collection_counter) call Mpi_Send(collection_id, 1, MPI_INTEGER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + msg =>f_d_ms(collection_counter)%msg_vec%at(1) ! just pick first one. All messages should have the same filename + select type (q=>msg) + class is (AbstractCollectiveDataMessage) + Filename = q%file_name + call Mpi_Send(FileName, FNAME_LEN, MPI_CHARACTER, this%back_ranks(1), this%back_ranks(1), this%server_comm, ierror) + class default + _FAIL( "yet to implemented") + end select + ! here thread_ptr can point to any thread hist_collection => thread_ptr%hist_collections%at(collection_id) call hist_collection%fmd%serialize(buffer) @@ -438,6 +451,7 @@ subroutine start_back(this, rc) integer, parameter :: stag = 6782 integer :: status + type (StringSet) :: FilesBeingWritten allocate(this%serverthread_done_msgs(1)) this%serverthread_done_msgs(:) = .false. @@ -462,6 +476,7 @@ subroutine start_back_captain(rc) integer :: i, no_job, local_rank, node_rank, nth_writer integer :: terminate, idle_writer, ierr integer :: MPI_STAT(MPI_STATUS_SIZE) + character(len=FNAME_LEN) :: FileName nwriter_per_node = this%nwriter/this%Node_Num allocate(num_idlePEs(0:this%Node_Num-1)) @@ -482,8 +497,12 @@ subroutine start_back_captain(rc) this%front_ranks(1), this%back_ranks(1), this%server_comm, & MPI_STAT, ierr) if (collection_id == -1) exit + + call MPI_recv( FileName, FNAME_LEN , MPI_CHARACTER, & + this%front_ranks(1), this%back_ranks(1), this%server_comm, & + MPI_STAT, ierr) ! 2) get an idle processor and notify front root - call dispatch_work(collection_id, idleRank, num_idlePEs, rc=status) + call dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc=status) _VERIFY(status) enddo ! while .true. @@ -498,16 +517,19 @@ subroutine start_back_captain(rc) _RETURN(_SUCCESS) end subroutine start_back_captain - subroutine dispatch_work(collection_id, idleRank, num_idlePEs, rc) + subroutine dispatch_work(collection_id, idleRank, num_idlePEs, FileName, rc) integer, intent(in) :: collection_id integer, intent(inout) :: idleRank(0:,0:) integer, intent(inout) :: num_idlePEs(0:) + character(*), intent(in) :: FileName integer, optional, intent(out) :: rc integer :: MPI_STAT(MPI_STATUS_SIZE) integer :: local_rank, idle_writer, nth_writer, node_rank integer :: i, ierr, nwriter_per_node logical :: flag + character(len=FNAME_LEN) :: FileDone + type (StringSetIterator) :: iter ! 2.1) try to retrieve idle writers ! keep looping (waiting) until there are idle processors @@ -526,10 +548,21 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, rc) num_idlePEs(node_rank) = num_idlePEs(node_rank) + 1 nth_writer = mod(local_rank, nwriter_per_node) idleRank(node_rank, nth_writer) = local_rank + + call MPI_recv(FileDone, FNAME_LEN, MPI_CHARACTER, & + local_rank, stag+1, this%back_comm, & + MPI_STAT, ierr) + + iter = FilesBeingWritten%find(FileDone) + _ASSERT( iter /= FilesBeingWritten%end(), "FileDone should be in the set") + iter = FilesBeingWritten%erase(iter) endif enddo ! if there is no idle processor, get back to probe if (all(num_idlePEs == 0)) cycle + ! if this file is still being written, get back to probe + iter = FilesBeingWritten%find(FileName) + if (iter /= FilesBeingWritten%end()) cycle ! get the node with the most idle processors node_rank = maxloc(num_idlePEs, dim=1) - 1 @@ -541,7 +574,8 @@ subroutine dispatch_work(collection_id, idleRank, num_idlePEs, rc) exit enddo _ASSERT(1<= idle_writer .and. idle_writer <= this%nwriter-1, "wrong local rank of writer") - exit ! exit while loop after get one idle processor + call FilesBeingWritten%insert(FileName) + exit ! exit the loop after get one idle processor and the file is done enddo ! while, get one idle writer ! 2.2) tell front comm which idel_worker is ready @@ -559,6 +593,7 @@ subroutine terminate_back_writers(idleRank, rc) integer :: MPI_STAT(MPI_STATUS_SIZE) integer :: node_rank, local_rank, nth_writer integer :: ierr, no_job, nwriter_per_node, idle_writer + character(len=FNAME_LEN) :: FileDone no_job = -1 nwriter_per_node = size(idleRank, 2) @@ -574,6 +609,9 @@ subroutine terminate_back_writers(idleRank, rc) call MPI_recv( idle_writer, 1, MPI_INTEGER, & local_rank, stag, this%back_comm, & MPI_STAT, ierr) + call MPI_recv( FileDone, FNAME_LEN, MPI_CHARACTER, & + local_rank, stag+1, this%back_comm, & + MPI_STAT, ierr) _ASSERT(local_rank == idle_writer, "local_rank and idle_writer should match") call MPI_send(no_job, 1, MPI_INTEGER, local_rank, local_rank, this%back_comm, ierr) endif @@ -612,6 +650,7 @@ subroutine start_back_writers(rc) type(AdvancedMeter) :: file_timer real(kind=REAL64) :: time character(len=:), allocatable :: filename + character(len=FNAME_LEN) :: FileDone real(kind=REAL64) :: file_size, speed class(Logger), pointer :: lgr @@ -828,7 +867,10 @@ subroutine start_back_writers(rc) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! telling captain it is idle by sending its own rank !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call MPI_send(back_local_rank, 1, MPI_INTEGER, 0, stag, this%back_comm , ierr) + FileDone = Filename + call MPI_send(FileDone, FNAME_LEN, MPI_CHARACTER, 0, stag+1, this%back_comm , ierr) enddo _RETURN(_SUCCESS) end subroutine start_back_writers diff --git a/run_cmake b/run_cmake new file mode 100755 index 000000000000..6d83cef21e04 --- /dev/null +++ b/run_cmake @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_INSTALL_PREFIX=../install -DCMAKE_BUILD_TYPE=Debug diff --git a/run_cmake.gfortran b/run_cmake.gfortran new file mode 100755 index 000000000000..f4bcb4d34bd3 --- /dev/null +++ b/run_cmake.gfortran @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_INSTALL_PREFIX=../install diff --git a/run_cmake.ifort b/run_cmake.ifort new file mode 100755 index 000000000000..0a546a67bfe7 --- /dev/null +++ b/run_cmake.ifort @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_INSTALL_PREFIX=../install diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 620e1553e64a..46389b996a12 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -28,6 +28,7 @@ set (srcs MAPL_DateTime_Parsing.F90 DownBit.F90 ShaveMantissa.c + MAPL_Sleep.F90 # Fortran submodules Interp/Interp.F90 Interp/Interp_implementation.F90 Shmem/Shmem.F90 Shmem/Shmem_implementation.F90 diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 8b2efc79ed5d..125d2eaabfc1 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -28,7 +28,7 @@ ! hh?mm or Thhmm ! hh ! hh is the zero-padded hour (24 hour system). -! mm is the zero-padded minute. +! mm is the zero-padded minute. ! ss is the zero-padded second. ! sss is the fractional second. It represents an arbitrary number of digits (currrently limited to 3). ! @@ -41,6 +41,7 @@ module MAPL_DateTime_Parsing use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling + use gFTL_StringVector use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 implicit none @@ -55,10 +56,10 @@ module MAPL_DateTime_Parsing public :: is_positive_digit public :: MAX_CHARACTER_LENGTH -! private +! private - interface operator(.divides.) - module procedure :: divides + interface operator(.multipleof.) + module procedure :: divisible_by end interface interface operator(.in.) @@ -67,7 +68,7 @@ module MAPL_DateTime_Parsing interface operator(.between.) module procedure :: is_in_open_interval - end interface + end interface interface operator(.isvalidindexof.) module procedure :: valid_index @@ -115,32 +116,31 @@ module MAPL_DateTime_Parsing module procedure :: construct_time_fields_null end interface time_fields - type :: datetime_fields - integer :: yy = 0 - integer :: mm = 0 - integer :: dd = 0 - integer :: h = 0 - integer :: m = 0 - integer :: s = 0 - real :: sr8 = 0.0 - contains - procedure, public, pass(this) :: as_array => datetime_fields_as_array - end type datetime_fields - - interface datetime_fields - module procedure :: construct_datetime_fields - module procedure :: construct_datetime_fields_array - interface datetime_fields +! type :: datetime_fields +! integer :: yy = 0 +! integer :: mm = 0 +! integer :: dd = 0 +! integer :: h = 0 +! integer :: m = 0 +! integer :: s = 0 +! real :: sr8 = 0.0 +! contains +! procedure, public, pass(this) :: as_array => datetime_fields_as_array +! end type datetime_fields +! +! interface datetime_fields +! module procedure :: construct_datetime_fields +! module procedure :: construct_datetime_fields_array +! end interface datetime_fields ! DATETIME_DURATION: Derived type for communicating datetime durations internally - + type :: datetime_duration - public integer :: year, month, day, hour, minute, second real(kind=R64) :: hour_real, minute_real, second_real logical :: hour_is_set, minute_is_set, second_is_set + logical :: year_is_set, month_is_set, day_is_set contains - public procedure, pass(this) :: set_year => set_year_datetime_duration procedure, pass(this) :: set_month => set_month_datetime_duration procedure, pass(this) :: set_day => set_day_datetime_duration @@ -150,9 +150,9 @@ module MAPL_DateTime_Parsing procedure, pass(this) :: set_hour_real => set_hour_real_datetime_duration procedure, pass(this) :: set_minute_real => set_minute_real_datetime_duration procedure, pass(this) :: set_second_real => set_second_real_datetime_duration - procedure, pass(this) :: set_real_value => set_real_value_datetime_duration - procedure, pass(this) :: set_integer_value => set_integer_value_datetime_duration - generic :: set_value => set_real_value, set_integer_value + procedure, pass(this) :: set_real_value_datetime_duration + procedure, pass(this) :: set_integer_value_datetime_duration + generic :: set_value => set_integer_value_datetime_duration, set_real_value_datetime_duration end type datetime_duration interface datetime_duration @@ -178,6 +178,9 @@ module MAPL_DateTime_Parsing integer(kind(TIME_UNIT)), parameter :: NUM_TIME_UNITS = LAST_TIME_UNIT - 1 + integer, parameter :: MAX_CHARACTER_LENGTH = 64 + character(len=MAX_CHARACTER_LENGTH), target :: time_units(NUM_TIME_UNITS) + ! END TIME_UNIT @@ -190,24 +193,23 @@ module MAPL_DateTime_Parsing ! Timezone offset for Timezone Z !wdb keep for now integer, parameter :: Z = 0 - integer, parameter :: MAX_CHARACTER_LENGTH = 64 contains ! NUMBER HANDLING PROCEDURES ! Return true if factor divides dividend evenly, false otherwise - pure logical function divides(factor, dividend) + pure logical function divisible_by(factor, dividend) integer, intent(in) :: factor integer, intent(in) :: dividend - ! mod returns the remainder of dividend/factor, + ! mod returns the remainder of dividend/factor, ! and if it is 0, factor divides dividend evenly if(factor /= 0) then ! To avoid divide by 0 - divides = mod(dividend, factor)==0 + divisible_by = mod(dividend, factor)==0 else - divides = .FALSE. + divisible_by = .FALSE. endif - end function divides + end function divisible_by pure logical function is_in_closed_interval(n, clint) integer, intent(in) :: n @@ -309,7 +311,7 @@ pure function undelimit(string, delimiter) result(undelimited) character(len=len(string)) :: undelimited integer :: i integer :: j - + undelimited = string if(len_trim(delimiter) <= 0) return @@ -354,7 +356,7 @@ end function undelimit_all pure logical function is_leap_year(y) integer, intent(in) :: y ! Leap years are years divisible by 400 or (years divisible by 4 and not divisible by 100) - is_leap_year = (400 .divides. y) .or. ((4 .divides. y) .and. .not. (100 .divides. y)) + is_leap_year = (y .multipleof. 400) .or. ((y .multipleof. 4) .and. .not. (y .multipleof. 100)) end function is_leap_year ! Return the last day numbers of each month based on the year @@ -558,7 +560,7 @@ pure function parse_time(timestring, delimiter) result(fields) integer :: timezone_offset fields = time_fields() - + timestring_ = trim(timestring) ! Get timezone @@ -611,7 +613,7 @@ pure function parse_time(timestring, delimiter) result(fields) return end select - ! Read time fields + ! Read time fields hour = read_whole_number(undelimited(1:2)) minute = read_whole_number(undelimited(3:4)) second = read_whole_number(undelimited(5:6)) @@ -682,61 +684,61 @@ end function construct_time_fields_null ! DATETIME_FIELDS: - pure function construct_datetime_fields(yy, mm, dd, h, m, s, s8) result(fields) - integer, optional, intent(in) :: yy, mm, dd, h, m, s - real(kind=real64), optional, intent(in) :: s8 - type(datetime_fields) :: fields - - if(present(yy)) fields % yy = yy - if(present(mm)) fields % mm = mm - if(present(dd)) fields % dd = dd - if(present(h)) fields % h = h - if(present(m)) fields % m = m - - if(present(s8)) then - fields % s8 = s8 - fields % s = int(s8) - else if(present(s)) - fields % s = s - fields % s8 = real(s, real64) - end if - - end function construct_datetime_fields - - pure function construct_datetime_fields_array(dur, s8) result(fields) - integer, intent(in) :: dur - real(real64), optional, intent(in) :: s8 - type(datetime_fields) :: fields - integer :: yy, mm, dd, h, m, s - - yy = dur(1) - mm = dur(2) - dd = dur(3) - h = dur(4) - m = dur(5) - - if(present(s8)) then - fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s8 = s8) - return - end if - - fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s = s) - - end function construct_datetime_fields_array - - pure function datetime_fields_as_array(this) result(array) - class(datetime_fields), intent(in) :: this - integer :: array(6) - - array = [this % yy, this % mm, this % dd, this % h, this % m, this % s] +! pure function construct_datetime_fields(yy, mm, dd, h, m, s, s8) result(fields) +! integer, optional, intent(in) :: yy, mm, dd, h, m, s +! real(kind=R64), optional, intent(in) :: s8 +! type(datetime_fields) :: fields +! +! if(present(yy)) fields % yy = yy +! if(present(mm)) fields % mm = mm +! if(present(dd)) fields % dd = dd +! if(present(h)) fields % h = h +! if(present(m)) fields % m = m +! +! if(present(s8)) then +! fields % s8 = s8 +! fields % s = int(s8) +! else if(present(s)) then +! fields % s = s +! fields % s8 = real(s, R64) +! end if +! +! end function construct_datetime_fields +! +! pure function construct_datetime_fields_array(dur, s8) result(fields) +! integer, intent(in) :: dur +! real(R64), optional, intent(in) :: s8 +! type(datetime_fields) :: fields +! integer :: yy, mm, dd, h, m, s +! +! yy = dur(1) +! mm = dur(2) +! dd = dur(3) +! h = dur(4) +! m = dur(5) +! +! if(present(s8)) then +! fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s8 = s8) +! return +! end if +! +! fields = datetime_fields(yy = yy, mm = mm, dd = dd, h = h, m = m, s = s) +! +! end function construct_datetime_fields_array +! +! pure function datetime_fields_as_array(this) result(array) +! class(datetime_fields), intent(in) :: this +! integer :: array(6) +! +! array = [this % yy, this % mm, this % dd, this % h, this % m, this % s] +! +! end function datetime_fields_as_array - end function datetime_fields_as_array - ! DATETIME_DURATION: function construct_datetime_duration() result(that) type(datetime_duration) :: that - + that % year = 0 that % month = 0 that % day = 0 @@ -816,12 +818,12 @@ pure logical function are_valid_time_fields(this) class(time_fields), intent(in) :: this are_valid_time_fields = this%is_valid_ end function are_valid_time_fields - + ! DATETIME_DURATION: subroutine set_year_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status @@ -832,9 +834,9 @@ subroutine set_year_datetime_duration(this, val, rc) _RETURN(_SUCCESS) end subroutine set_year_datetime_duration - + subroutine set_month_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status @@ -845,9 +847,9 @@ subroutine set_month_datetime_duration(this, val, rc) _RETURN(_SUCCESS) end subroutine set_month_datetime_duration - + subroutine set_day_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status @@ -860,12 +862,14 @@ subroutine set_day_datetime_duration(this, val, rc) end subroutine set_day_datetime_duration subroutine set_hour_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % hour_is_set, 'Hour has already been set to a real value.') + if(.not. this % hour_is_set) then + _FAIL('Hour has already been set to a real value.') + end if this % hour = val this % hour_is_set = .FALSE. @@ -875,12 +879,14 @@ subroutine set_hour_datetime_duration(this, val, rc) end subroutine set_hour_datetime_duration subroutine set_hour_real_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this real(kind=R64), intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % hour_is_set, 'Hour has already been set to an integer value.') + if(.not. this % hour_is_set) then + _FAIL('Hour has already been set to an integer value.') + end if this % hour_real = val this % hour_is_set = .FALSE. @@ -890,12 +896,14 @@ subroutine set_hour_real_datetime_duration(this, val, rc) end subroutine set_hour_real_datetime_duration subroutine set_minute_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % minute_is_set, 'Minute has already been set to a real value'.) + if(.not. this % minute_is_set) then + _FAIL('Minute has already been set to a real value') + end if this % minute = val this % minute_is_set = .FALSE. @@ -905,12 +913,14 @@ subroutine set_minute_datetime_duration(this, val, rc) end subroutine set_minute_datetime_duration subroutine set_minute_real_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this real(kind=R64), intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % minute_is_set, 'Minute has already been set to an integer value.') + if(.not. this % minute_is_set) then + _FAIL('Minute has already been set to an integer value.') + end if this % minute_real = val this % minute_is_set = .FALSE. @@ -920,12 +930,14 @@ subroutine set_minute_real_datetime_duration(this, val, rc) end subroutine set_minute_real_datetime_duration subroutine set_second_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this integer, intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % second_is_set, 'Minute has already been set to a real value'.) + if(.not. this % second_is_set) then + _FAIL('Minute has already been set to a real value') + end if this % second = val this % second_is_set = .FALSE. @@ -935,12 +947,14 @@ subroutine set_second_datetime_duration(this, val, rc) end subroutine set_second_datetime_duration subroutine set_second_real_datetime_duration(this, val, rc) - class(datetime_duration), intent(in) :: this + class(datetime_duration), intent(inout) :: this real(kind=R64), intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(.not. this % second_is_set, 'Second has already been set to an integer value.') + if(.not. this % second_is_set) then + _FAIL('Second has already been set to an integer value.') + end if this % second_real = val this % second_is_set = .FALSE. @@ -949,8 +963,8 @@ subroutine set_second_real_datetime_duration(this, val, rc) end subroutine set_second_real_datetime_duration - subroutine set_value_datetime_duration_integer(this, tunit, val, rc) - class(datetime_duration), intent(in) :: this + subroutine set_integer_value_datetime_duration(this, tunit, val, rc) + class(datetime_duration), intent(inout) :: this integer(kind(TIME_UNIT)), intent(in) :: tunit integer, intent(in) :: val integer, optional, intent(out) :: rc @@ -972,17 +986,16 @@ subroutine set_value_datetime_duration_integer(this, tunit, val, rc) case default _FAIL('Invalid Time Unit') end select - - end subroutine set_value_datetime_duration_integer - subroutine set_value_datetime_duration_real(this, tunit, val, rc) - class(datetime_duration), intent(in) :: this + end subroutine set_integer_value_datetime_duration + + subroutine set_real_value_datetime_duration(this, tunit, val, rc) + class(datetime_duration), intent(inout) :: this integer(kind(TIME_UNIT)), intent(in) :: tunit real(kind=R64), intent(in) :: val integer, optional, intent(out) :: rc integer :: status - _ASSERT(tunit <= NUM_TIME_UNITS .and. tunit > 0, ) select case(tunit) case (HOUR) call this % set_hour_real(val) @@ -993,8 +1006,8 @@ subroutine set_value_datetime_duration_real(this, tunit, val, rc) case default _FAIL('Invalid Time Unit') end select - - end subroutine set_value_datetime_duration_integer + + end subroutine set_real_value_datetime_duration ! END CF Time: Type-bound procedues @@ -1020,11 +1033,13 @@ subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) character(len=len(datetime_string)) :: undelimited character(len=:), allocatable :: intermediate integer :: undelimited_length - + iso_string = datetime_string undelimited = adjustl(undelimit_all(datetime_string)) undelimited_length=len_trim(undelimited) - _ASSERT(undelimited_length >= MIN_LEN, 'datetime_string is too short: ' // trim(undelimited)) + if(undelimited_length >= MIN_LEN) then + _FAIL('datetime_string is too short: ') + end if intermediate = undelimited(N(1,YY):N(2,YY)) // ISO_DD // & undelimited(N(1,MM):N(2,MM)) // ISO_DD // & @@ -1034,16 +1049,16 @@ subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) undelimited(N(1,S):N(2,S)) if(undelimited_length > MIN_LEN) intermediate = & intermediate // ISO_POINT // undelimited(MIN_LEN+1:undelimited_length) - + iso_string = intermediate _RETURN(_SUCCESS) - end subroutine convert_to_ISO8601DateTime + end subroutine convert_to_ISO8601DateTime ! UTILITY PROCEDURES - + function is_valid_datestring(datestring, string_format) result(tval) character(len=*), intent(in) :: datestring character(len=*), intent(in) :: string_format @@ -1069,8 +1084,8 @@ end function is_valid_datestring logical function is_in_char_set(element, char_set) character, intent(in) :: element character(len=*), intent(in) :: char_set - is_in_set = (verify(element, char_set) == 0) - end function is_in_set + is_in_char_set = (verify(element, char_set) == 0) + end function is_in_char_set function find_delta(string, chars, istart, istop_in) result(next) character(len=*), intent(in) :: string @@ -1097,7 +1112,7 @@ function find_delta(string, chars, istart, istop_in) result(next) next = istart in_set = is_in_char_set(string(next:next), chars) - do + do next = next + 1 if(next > len(string)) exit if(in_set .neqv. is_in_char_set(string(next:next), chars)) exit @@ -1107,10 +1122,14 @@ end function find_delta function find_delta_datestring(string, istart, istop) result(next) character(len=*), intent(in) :: string - integer, intent(in) :: istart, istop + integer, intent(in) :: istart + integer, optional, intent(in) :: istop + integer :: istop_ integer :: next - next = find_delta(string, DIGITS, istart, istop) + istop_ = len(string) + if(present(istop)) istop_ = istop + next = find_delta(string, DIGIT_CHARACTERS, istart, istop) end function find_delta_datestring @@ -1122,19 +1141,23 @@ subroutine split_digit_string_delimited(string, parts, rc) integer :: next, start, strlen, last strlen = len(string) - _FAIL(strlen == 0, 'Empty string') + if(strlen == 0) then + _FAIL('Empty string') + end if start = 1 do - next = find_delta_datestring(string, start) + next = find_delta_datestring(string, start) if(.not. (next > start)) exit last = next - 1 - _ASSERT(last <= strlen, 'Exceeded string length') - parts % push_back(string(start:(next-1))) - start = next + if(last <= strlen) then + _FAIL('Exceeded string length') + end if + call parts % push_back(string(start:(next-1))) + start = next if(start > len(string)) exit end do - + _RETURN(_SUCCESS) end subroutine split_digit_string_delimited @@ -1143,7 +1166,7 @@ logical function valid_index(n, string) integer, intent(in) :: n character(len=*), intent(in) :: string - valid_index = .not. (n < 1 .or. n > len(string)) + valid_index = .not. (n < 1 .or. n > len(string)) end function valid_index @@ -1154,14 +1177,14 @@ subroutine split_digit_string_indexed(string, length, parts, rc) integer, optional, intent(out) :: rc integer, allocatable :: indices(:, :) integer :: status - integer :: i + integer :: i integer :: n(2) indices = convert_lengths_to_indices(length) - do i = 1, length(indices, 2) + do i = 1, size(indices, 2) n = indices(:,i) - parts % push_back(string(n(1):n(2))) + call parts % push_back(string(n(1):n(2))) end do _RETURN(_SUCCESS) @@ -1170,49 +1193,32 @@ end subroutine split_digit_string_indexed function convert_lengths_to_indices(length) result(indices) integer, intent(in) :: length(:) - integer :: indices(size(length), 2) + integer :: indices(2, size(length)) integer :: i indices(:, 1) = [1, length(1)] - do i = 2, size(indices) - indices(:, i) = [1, length(i)] + indices(i-1) + do i = 2, size(indices, 2) + indices(:, i) = indices(:,(i-1)) + [1, length(i)] end do - + end function convert_lengths_to_indices ! TIME_UNIT ==================================================================== - function time_units() result(units) - character(MAX_CHARACTER_LENGTH), allocatable, save :: units(:) - logical, save :: uninitialized = .TRUE. - - if(uninitialized) then - allocate(units(NUM_TIME_UNITS)) - units(YEAR) = "year" - units(MONTH) = "month" - units(DAY) = "day" - units(HOUR) = "hour" - units(MINUTE) = "minute" - units(SECOND) = "second" - uninitialized = .FALSE. - end if - - end function time_units - - function time_unit(unit_name, check_plural) result(n) + function get_time_unit(unit_name, check_plural) result(n) character(len=*), intent(in) :: unit_name - logical, intent(in) :: check_plural + logical, optional, intent(in) :: check_plural character(len=:), allocatable :: unit_name_ logical :: check_plural_ = .TRUE. - character(len=:), allocatable :: tunits(:) + character(len=:), pointer, save :: tunits(:) character(len=:), allocatable :: tunit, unit_name_plural character, parameter :: PLURAL = 's' - integer(kind(TIME_UNIT)) :: n, i + integer :: n, i if(present(check_plural)) check_plural_ = check_plural unit_name_ = trim(unit_name) - tunits = time_units() + tunits = get_time_units() n = TIME_UNIT_UNKNOWN do i = 1, NUM_TIME_UNITS @@ -1222,7 +1228,27 @@ function time_unit(unit_name, check_plural) result(n) exit end if end do - - end function time_unit + + contains + + function get_time_units() result(units) + character(len=:), pointer :: units(:) + logical, save :: initialized = .FALSE. + + if(.not. initialized) then + time_units(YEAR) = "year" + time_units(MONTH) = "month" + time_units(DAY) = "day" + time_units(HOUR) = "hour" + time_units(MINUTE) = "minute" + time_units(SECOND) = "second" + initialized = .TRUE. + end if + + units => time_units + + end function get_time_units + + end function get_time_unit end module MAPL_DateTime_Parsing diff --git a/shared/MAPL_Sleep.F90 b/shared/MAPL_Sleep.F90 new file mode 100644 index 000000000000..ca77c8412a72 --- /dev/null +++ b/shared/MAPL_Sleep.F90 @@ -0,0 +1,31 @@ +module MAPL_SleepMod + +use, intrinsic :: iso_fortran_env, only: REAL64,INT64 +implicit none +private + +public MAPL_Sleep + +contains + +! wait time in seconds +subroutine MAPL_Sleep(wait_time) +real, intent(in) :: wait_time + +integer(kind=INT64) :: s1,s2,count_max,count_rate,delta +real(kind=REAL64) :: seconds_elapsed + +call system_clock(count=s1,count_rate=count_rate,count_max=count_max) + +do + + call system_clock(count=s2) + delta = s2-s1 + if (delta < 0) delta= s2 + (count_max - mod(s1,count_max)) + seconds_elapsed = dble(delta)/dble(count_rate) + if (seconds_elapsed > wait_time) exit + +enddo + +end subroutine +end module MAPL_SleepMod diff --git a/shared/MaplShared.F90 b/shared/MaplShared.F90 index 404e987803a1..859c3e5392c4 100644 --- a/shared/MaplShared.F90 +++ b/shared/MaplShared.F90 @@ -21,5 +21,6 @@ module MaplShared use mapl_CommGroupDescriptionMod use mapl_AbstractCommSplitterMod use mapl_DownbitMod + use mapl_sleepMod end module MaplShared diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index ad81aa9a65f3..a96cbb42a186 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -605,7 +605,7 @@ contains end subroutine test_convert_to_ISO8601DateTime - !@test + @test subroutine test_construct_datetime_duration() integer, parameter :: IEX = 0 real, parameter :: REX = 0.0 @@ -626,14 +626,14 @@ contains @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.' end subroutine test_construct_datetime_duration - !@test + @test subroutine test_time_units() character(len=:), allocatable :: units units = time_units() @assertEqual(NUM_TIME_UNITS, size(units), 'time_units has an incorrect size.') end subroutine test_time_units - !@test + @test subroutine test_time_unit() integer(kind(TIME_UNIT)) :: tu integer :: i @@ -650,41 +650,40 @@ contains i = i + 1 write(run_number, fmt=fmt_) i run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(YEAR, time_unit('year'), run_name // msg // 'year.') - @assertEqual(MONTH, time_unit('month'), run_name // msg // 'month.') - @assertEqual(DAY, time_unit('day'), run_name // msg // 'day.') - @assertEqual(HOUR, time_unit('hour'), run_name // msg // 'hour.') - @assertEqual(MINUTE, time_unit('minute'), run_name // msg // 'minute.') - @assertEqual(SECOND, time_unit('second'), run_name // msg // 'second.') + @assertEqual(YEAR, get_time_unit('year'), run_name // msg // 'year.') + @assertEqual(MONTH, get_time_unit('month'), run_name // msg // 'month.') + @assertEqual(DAY, get_time_unit('day'), run_name // msg // 'day.') + @assertEqual(HOUR, get_time_unit('hour'), run_name // msg // 'hour.') + @assertEqual(MINUTE, get_time_unit('minute'), run_name // msg // 'minute.') + @assertEqual(SECOND, get_time_unit('second'), run_name // msg // 'second.') end do do while(i < 3) i = i + 1 write(run_number, fmt=fmt_) i run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(YEAR, time_unit('years'), run_name // msg // 'years.') - @assertEqual(MONTH, time_unit('months'), run_name // msg // 'months.') - @assertEqual(DAY, time_unit('days'), run_name // msg // 'days.') - @assertEqual(HOUR, time_unit('hours'), run_name // msg // 'hours.') - @assertEqual(MINUTE, time_unit('minutes'), run_name // msg // 'minutes.') - @assertEqual(SECOND, time_unit('seconds'), run_name // msg // 'seconds.') + @assertEqual(YEAR, get_time_unit('years'), run_name // msg // 'years.') + @assertEqual(MONTH, get_time_unit('months'), run_name // msg // 'months.') + @assertEqual(DAY, get_time_unit('days'), run_name // msg // 'days.') + @assertEqual(HOUR, get_time_unit('hours'), run_name // msg // 'hours.') + @assertEqual(MINUTE, get_time_unit('minutes'), run_name // msg // 'minutes.') + @assertEqual(SECOND, get_time_unit('seconds'), run_name // msg // 'seconds.') end do - msg = 'Should return TIME_UNIT_UNKNOWN' + msg = 'Should return get_time_unit_UNKNOWN' do while(i < 4) i = i + 1 write(run_number, fmt=fmt_) i run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('years', check_plural), run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('months', check_plural), run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('days'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('hours'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('minutes'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('seconds'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, time_unit('furlong'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('years', check_plural), run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('months', check_plural), run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('days'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('hours'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('minutes'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('seconds'), check_plural, run_name // msg) + @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('furlong'), check_plural, run_name // msg) end do end subroutine test_time_unit - end module test_MAPL_DateTime_Parsing From ab17d17e4c5568c081ff70bb1a28f9a864b9e32d Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 7 Aug 2023 15:16:21 -0400 Subject: [PATCH 15/32] Updates to MAPL_NetCDF, MAPL_DateTime_Parsing.F90 test_MAPL_DateTime_Parsing.pf --- base/MAPL_NetCDF.F90 | 123 ++++++++--------- shared/MAPL_DateTime_Parsing.F90 | 10 +- shared/tests/test_MAPL_DateTime_Parsing.pf | 148 ++++++++++----------- 3 files changed, 133 insertions(+), 148 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 0ac4a89a553e..fbe327b65ff4 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -5,70 +5,6 @@ ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} -module cf_timeunit_mod - - implicit none - - public :: CF_TimeUnit - - private - - type :: CF_TimeUnit - contains - procedure, public, pass(this) :: name - procedure, public, pass(this) :: is_null - end type CF_TimeUnit - - interface CF_TimeUnit - module procedure :: get_cf_timeunit - end interface CF_TimeUnit - - type, extends(CF_TimeUnit) :: CF_TimeUnit_Impl - private - character(len=:), allocatable :: name_ - logical, protected :: is_null_ = .FALSE. - contains - procedure, public, pass(this) :: name => name_impl - procedure, public, pass(this) :: is_null => is_null_impl - end type CF_TimeUnit - - type(CF_TimeUnit_Impl) :: cf_timeunits(0:2) = [CF_TimeUnit('unspecified', .TRUE.),& - CF_TimeUnit('hours'), CF_TimeUnit('minutes'), CF_TimeUnit('seconds')] - - interface CF_TimeUnit_Impl - module procedure :: mk_cf_tunit - end interface CF_TimeUnit_Impl - -contains - - function mk_cf_timenit(unit_name) result(tunit) - character(len=*), intent(in) :: unit_name - type(CF_TimeUnit_Impl) :: tunit - - tunit % name_ = unit_name - - end function mk_cf_timenit - - function get_cf_timeunit(unit_name) result(tunit) - character(len=*), optional, intent(in) :: unit_name - class(CF_TimeUnit) :: tunit - integer :: i - - if(present(unit_name)) then - ! starts at 1 to skip the null unit - do i = 1, size(cf_timeunits) - tunit = cf_timeunits(i) - if(tunit % name() == unit_name) return - end do - end if - - ! if no match, return null unit (index 0) - tunit = cf_timeunits(0) - - end function get_cf_timeunit - -end module cf_timeunit_mod - module MAPL_NetCDF use MAPL_ExceptionHandling @@ -80,7 +16,6 @@ module MAPL_NetCDF public :: get_NetCDF_duration_from_ESMF_Time public :: get_ESMF_Time_from_NetCDF_DateTime - public :: CF_TimeUnit interface get_NetCDF_duration_from_ESMF_Time module procedure :: get_NetCDF_duration_from_ESMF_Time_integer @@ -115,6 +50,7 @@ module MAPL_NetCDF character, parameter :: PART_DELIM = ' ' character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' + character, parameter :: DELIMS(3) = [PART_DELIM, DATE_DELIM, TIME_DELIM] character, parameter :: POINT = '.' character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' @@ -135,12 +71,64 @@ module MAPL_NetCDF character(len=*), parameter :: EMPTY_STRING = '' integer, parameter :: MAX_CHARACTER_LENGTH = 64 - contains !=============================================================================== !========================= HIGH-LEVEL PROCEDURES =========================== + ! Convert NetCDF_DateTime {int_time, units_string} to + ! ESMF time variables {interval, time0, time1} and time unit {tunit} + ! time0 is the start time, and time1 is time0 + interval + subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & + interval, time0, unusable, time1, tunit, rc) + integer, intent(in) :: int_time + character(len=*), intent(in) :: units_string + type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: time0 + class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(inout) :: time1 + character(len=:), allocatable, optional, intent(out) :: tunit + integer, optional, intent(out) :: rc + character(len=:), allocatable :: tunit_ + character(len=len_trim(units_string)) :: parts(2) + character(len=len_trim(units_string)) :: head + character(len=len_trim(units_string)) :: tail + + integer :: span, factor + integer :: status + + _UNUSED_DUMMY(unusable) + + _ASSERT(int_time >= 0, 'Negative span not supported') + _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') + + ! get time unit, tunit + parts = split(lr_trim(units_string), PART_DELIM) + head = parts(1) + tail = parts(2) + tunit_ = lr_trim(head) + _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') + if(present(tunit)) tunit = tunit_ + + ! get span + parts = split(lr_trim(tail), PART_DELIM) + head = parts(1) + tail = parts(2) + + factor = get_shift_sign(head) + _ASSERT(factor /= 0, 'Unrecognized preposition') + span = factor * int_time + + call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) + call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) + + ! get time1 + if(present(time1)) time1 = time0 + interval + + _RETURN(_SUCCESS) + + end subroutine convert_NetCDF_DateTime_to_ESMF + ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) type(ESMF_Time), intent(inout) :: time @@ -356,6 +344,7 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, dat part = datetime_string(i:j) call convert_to_integer(part, s, rc = status) _ASSERT(status == 0, 'Unable to convert second string') + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) _RETURN(_SUCCESS) @@ -407,6 +396,8 @@ subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, _ASSERT(status == 0, 'Unable to convert second string') ! no need to call this unless datetime units are correct + call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) + call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) _RETURN(_SUCCESS) diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 125d2eaabfc1..9bebbc26d07f 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -59,7 +59,7 @@ module MAPL_DateTime_Parsing ! private interface operator(.multipleof.) - module procedure :: divisible_by + module procedure :: multipleof end interface interface operator(.in.) @@ -199,17 +199,17 @@ module MAPL_DateTime_Parsing ! NUMBER HANDLING PROCEDURES ! Return true if factor divides dividend evenly, false otherwise - pure logical function divisible_by(factor, dividend) + pure logical function multipleof(factor, dividend) integer, intent(in) :: factor integer, intent(in) :: dividend ! mod returns the remainder of dividend/factor, ! and if it is 0, factor divides dividend evenly if(factor /= 0) then ! To avoid divide by 0 - divisible_by = mod(dividend, factor)==0 + multipleof = mod(dividend, factor)==0 else - divisible_by = .FALSE. + multipleof = .FALSE. endif - end function divisible_by + end function multipleof pure logical function is_in_closed_interval(n, clint) integer, intent(in) :: n diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index a96cbb42a186..6491b0d9d267 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -14,6 +14,7 @@ module test_MAPL_DateTime_Parsing character(len=*), parameter :: TIME_DELIMITER = ':' integer, dimension(12), parameter :: ENDS = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] integer, dimension(size(ENDS)), parameter :: ENDS_LEAP = [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] + integer, parameter :: MAX_LEN = 1024 integer, parameter :: SUCCESS = _SUCCESS integer, parameter :: FAILURE = _FAILURE @@ -21,12 +22,12 @@ module test_MAPL_DateTime_Parsing contains @test - subroutine test_divides() - @assertTrue(divides(7, 21)) - @assertFalse(divides(7, 22)) - @assertTrue(7 .divides. 21) - @assertFalse(7 .divides. 22) - end subroutine test_divides + subroutine test_multipleof() + @assertTrue(multipleof(21, 7)) + @assertFalse(multipleof(22, 7)) + @assertTrue(21 .multipleof. 7) + @assertFalse(22 .multipleof. 7) + end subroutine test_multipleof @test subroutine test_between_op() @@ -612,78 +613,71 @@ contains logical, parameter :: LEX = .FALSE. type(datetime_duration) :: d d = datetime_duration() - @assertEqual(IEX, d % year, 'year should be 0' - @assertEqual(IEX, d % month, 'month should be 0' - @assertEqual(IEX, d % day, 'day should be 0' - @assertEqual(IEX, d % hour, 'hour should be 0' - @assertEqual(IEX, d % minute, 'minute should be 0' - @assertEqual(IEX, d % second, 'second should be 0' - @assertEqual(REX, d % hour_real, 'hour_real should be 0.0' - @assertEqual(REX, d % minute_real, 'minute_real should be 0.0' - @assertEqual(REX, d % second_real, 'second_real should be 0.0' - @assertFalse(d % hour_is_set, 'hour_is_set should be .FALSE.' - @assertFalse(d % minute_is_set, 'minute_is_set should be .FALSE.' - @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.' + @assertEqual(IEX, d % year, 'year should be 0') + @assertEqual(IEX, d % month, 'month should be 0') + @assertEqual(IEX, d % day, 'day should be 0') + @assertEqual(IEX, d % hour, 'hour should be 0') + @assertEqual(IEX, d % minute, 'minute should be 0') + @assertEqual(IEX, d % second, 'second should be 0') + @assertEqual(REX, d % hour_real, 'hour_real should be 0.0') + @assertEqual(REX, d % minute_real, 'minute_real should be 0.0') + @assertEqual(REX, d % second_real, 'second_real should be 0.0') + @assertFalse(d % hour_is_set, 'hour_is_set should be .FALSE.') + @assertFalse(d % minute_is_set, 'minute_is_set should be .FALSE.') + @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.') end subroutine test_construct_datetime_duration - @test - subroutine test_time_units() - character(len=:), allocatable :: units - units = time_units() - @assertEqual(NUM_TIME_UNITS, size(units), 'time_units has an incorrect size.') - end subroutine test_time_units - - @test - subroutine test_time_unit() - integer(kind(TIME_UNIT)) :: tu - integer :: i - logical :: check_plural = .FALSE. - character(len=:), allocatable :: run_name - character(len=:), allocatable :: fmt_ = '(I)' - character(len=4) :: run_number - character(len=:), allocatable :: msg - - i = 0 - - msg = 'Incorrect Time Unit for ' - do while(i < 2) - i = i + 1 - write(run_number, fmt=fmt_) i - run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(YEAR, get_time_unit('year'), run_name // msg // 'year.') - @assertEqual(MONTH, get_time_unit('month'), run_name // msg // 'month.') - @assertEqual(DAY, get_time_unit('day'), run_name // msg // 'day.') - @assertEqual(HOUR, get_time_unit('hour'), run_name // msg // 'hour.') - @assertEqual(MINUTE, get_time_unit('minute'), run_name // msg // 'minute.') - @assertEqual(SECOND, get_time_unit('second'), run_name // msg // 'second.') - end do - - do while(i < 3) - i = i + 1 - write(run_number, fmt=fmt_) i - run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(YEAR, get_time_unit('years'), run_name // msg // 'years.') - @assertEqual(MONTH, get_time_unit('months'), run_name // msg // 'months.') - @assertEqual(DAY, get_time_unit('days'), run_name // msg // 'days.') - @assertEqual(HOUR, get_time_unit('hours'), run_name // msg // 'hours.') - @assertEqual(MINUTE, get_time_unit('minutes'), run_name // msg // 'minutes.') - @assertEqual(SECOND, get_time_unit('seconds'), run_name // msg // 'seconds.') - end do - - msg = 'Should return get_time_unit_UNKNOWN' - do while(i < 4) - i = i + 1 - write(run_number, fmt=fmt_) i - run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('years', check_plural), run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('months', check_plural), run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('days'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('hours'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('minutes'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('seconds'), check_plural, run_name // msg) - @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('furlong'), check_plural, run_name // msg) - end do - - end subroutine test_time_unit +! @test +! subroutine test_time_unit() +! integer(kind(TIME_UNIT)) :: tu +! integer :: i +! logical :: check_plural = .FALSE. +! character(len=:), allocatable :: run_name +! character(len=*), parameter :: fmt_ = '(I)' +! character(len=4) :: run_number +! character(len=:), allocatable :: msg +! +! i = 0 +! +! msg = 'Incorrect Time Unit for ' +! do while(i < 2) +! i = i + 1 +! write(run_number, fmt=fmt_) i +! run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' +! @assertEqual(YEAR, get_time_unit('year'), run_name // msg // 'year.') +! @assertEqual(MONTH, get_time_unit('month'), run_name // msg // 'month.') +! @assertEqual(DAY, get_time_unit('day'), run_name // msg // 'day.') +! @assertEqual(HOUR, get_time_unit('hour'), run_name // msg // 'hour.') +! @assertEqual(MINUTE, get_time_unit('minute'), run_name // msg // 'minute.') +! @assertEqual(SECOND, get_time_unit('second'), run_name // msg // 'second.') +! end do +! +! do while(i < 3) +! i = i + 1 +! write(run_number, fmt=fmt_) i +! run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' +! @assertEqual(YEAR, get_time_unit('years'), run_name // msg // 'years.') +! @assertEqual(MONTH, get_time_unit('months'), run_name // msg // 'months.') +! @assertEqual(DAY, get_time_unit('days'), run_name // msg // 'days.') +! @assertEqual(HOUR, get_time_unit('hours'), run_name // msg // 'hours.') +! @assertEqual(MINUTE, get_time_unit('minutes'), run_name // msg // 'minutes.') +! @assertEqual(SECOND, get_time_unit('seconds'), run_name // msg // 'seconds.') +! end do +! +! msg = 'Should return get_time_unit_UNKNOWN' +! do while(i < 4) +! i = i + 1 +! write(run_number, fmt=fmt_) i +! run_name = 'RUN ' // trim(adjustl(run_number)) // ' : ' +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('years', check_plural), run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('months', check_plural), run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('days'), check_plural, run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('hours'), check_plural, run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('minutes'), check_plural, run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('seconds'), check_plural, run_name // msg) +! @assertEqual(TIME_UNIT_UNKNOWN, get_time_unit('furlong'), check_plural, run_name // msg) +! end do +! +! end subroutine test_time_unit end module test_MAPL_DateTime_Parsing From 3e774857c1e0dc270c4838f3596b7bcd297419b9 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 15 Aug 2023 15:24:06 -0400 Subject: [PATCH 16/32] Remove unused CF_Time modules; update MAPL_* modules --- base/CMakeLists.txt | 1 + base/MAPL_DateTime_Parsing_ESMF.F90 | 56 +++ base/MAPL_NetCDF.F90 | 652 +++------------------------- shared/CF_Time.F90 | 20 - shared/CF_Time_Integer.F90 | 38 -- shared/CF_Time_Real.F90 | 38 -- shared/CF_Time_def.F90 | 27 -- shared/CMakeLists.txt | 1 + shared/MAPL_CF_Time.F90 | 205 ++++++--- shared/MAPL_DateTime_Parsing.F90 | 47 +- shared/MAPL_ISO8601_DateTime.F90 | 6 + 11 files changed, 309 insertions(+), 782 deletions(-) create mode 100644 base/MAPL_DateTime_Parsing_ESMF.F90 delete mode 100644 shared/CF_Time.F90 delete mode 100644 shared/CF_Time_Integer.F90 delete mode 100644 shared/CF_Time_Real.F90 delete mode 100644 shared/CF_Time_def.F90 diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index abfccdcf963f..66bb0541f366 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -55,6 +55,7 @@ set (srcs MAPL_Resource.F90 MAPL_XYGridFactory.F90 MAPL_NetCDF.F90 + MAPL_DateTime_Parsing_ESMF.F90 # Orphaned program: should not be in this library. # tstqsat.F90 ) diff --git a/base/MAPL_DateTime_Parsing_ESMF.F90 b/base/MAPL_DateTime_Parsing_ESMF.F90 new file mode 100644 index 000000000000..1a09876ad3df --- /dev/null +++ b/base/MAPL_DateTime_Parsing_ESMF.F90 @@ -0,0 +1,56 @@ +module MAPL_DateTimeParsing_ESMF + + use MAPL_DateTimeParsing + + implicit none + +contains + + subroutine set_ESMF_TimeInterval_from_datetime_duration(interval, duration, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + class(datetime_duration), intent(in) :: duration + integer, optional, intent(out) :: rc + integer :: status + + ! Get duration(s) from datetime_duration + + ! Set ESMF_TimeInterval + if(this % year_is_set) call ESMF_TimeIntervalSet(interval, yy = this % year, _RC) + if(this % month_is_set) call ESMF_TimeIntervalSet(interval, yy = this % month, _RC) + if(this % day_is_set) call ESMF_TimeIntervalSet(interval, yy = this % day, _RC) + + if(this % hour_is_real) then + call ESMF_TimeIntervalSet(interval, h_r8 = this % hour_real, _RC) + else if(this % hour_is_set) then + call ESMF_TimeIntervalSet(interval, h = this % hour, _RC) + end if + + if(this % minute_is_real) then + call ESMF_TimeIntervalSet(interval, m_r8 = this % minute_real, _RC) + else if(this % minute_is_set) then + call ESMF_TimeIntervalSet(interval, m = this % minute, _RC) + end if + + if(this % second_is_real) then + call ESMF_TimeIntervalSet(interval, s_r8 = this % second_real, _RC) + else if(this % second_is_set) then + call ESMF_TimeIntervalSet(interval, s = this % second, _RC) + end if + + _RETURN(_SUCCESS) + + end subroutine set_ESMF_TimeInterval_from_datetime_duration + + subroutine set_ESMF_Time_from_ISO8601(time, isostring, rc) + type(ESMF_Time), intent(inout) :: time + character(len=*), intent(in) :: isostring + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_TimeSet(time, isostring, _RC) + + _RETURN(_SUCCESS) + + end subroutine set_ESMF_Time_from_ISO8601 + +end module MAPL_DateTimeParsing_ESMF diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index fbe327b65ff4..5a89ad2893e8 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -1,74 +1,31 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" -! Procedures to convert between NetCDF datetime and ESMF_Time +! Procedures to convert from NetCDF datetime to ESMF_Time and ESMF_TimeInterval ! NetCDF datetime is: {integer, character(len=*)} ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} - module MAPL_NetCDF + use, intrinsic :: iso_fortran_env, only: R64 => real64 use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod - use MAPL_DateTime_Parsing - use ESMF + use MAPL_DateTime_Parsing, only: datetime_duration + use MAPL_DateTime_Parsing_ESMF, only: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 + use MAPL_CF_Time, only: CF_Time, convert_CF_Time_to_datetime_duration, & + extract_ISO8601_from_CF_Time, extract_CF_Time_unit + use ESMF, only: ESMF_Time, ESMF_Time implicit none - public :: get_NetCDF_duration_from_ESMF_Time - public :: get_ESMF_Time_from_NetCDF_DateTime - - interface get_NetCDF_duration_from_ESMF_Time - module procedure :: get_NetCDF_duration_from_ESMF_Time_integer - module procedure :: get_NetCDF_duration_from_ESMF_Time_real - end interface get_NetCDF_duration_from_ESMF_Time - - interface get_ESMF_Time_from_NetCDF_DateTime - module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer - module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real - end interface get_ESMF_Time_from_NetCDF_DateTime + public :: convert_NetCDF_DateTime_to_ESMF private - ! LOW-LEVEL - keep commented out (private) unless debugging these procedures - public :: convert_NetCDF_DateTimeString_to_ESMF_Time, make_NetCDF_DateTime_duration, is_digit_string, get_shift_sign - public :: make_ESMF_TimeInterval, is_valid_netcdf_datetime_string, convert_to_integer, convert_to_real, split + interface convert_NetCDF_DateTime_to_ESMF + module procedure :: convert_NetCDF_DateTime_to_ESMF_integer + module procedure :: convert_NetCDF_DateTime_to_ESMF_real + end interface convert_NetCDF_DateTime_to_ESMF - interface make_ESMF_TimeInterval - module procedure :: make_ESMF_TimeInterval_integer - module procedure :: make_ESMF_TimeInterval_real - end interface make_ESMF_TimeInterval - - interface make_NetCDF_DateTime_duration - module procedure :: make_NetCDF_DateTime_duration_integer - module procedure :: make_NetCDF_DateTime_duration_real - end interface make_NetCDF_DateTime_duration - - interface split - module procedure :: split_characters - end interface split - - character, parameter :: PART_DELIM = ' ' - character, parameter :: DATE_DELIM = '-' - character, parameter :: TIME_DELIM = ':' - character, parameter :: DELIMS(3) = [PART_DELIM, DATE_DELIM, TIME_DELIM] - character, parameter :: POINT = '.' - character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' - character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' - character(len=*), parameter :: NETCDF_DATETIME = NETCDF_DATE // PART_DELIM // NETCDF_TIME - integer, parameter :: LEN_DATE = len(NETCDF_DATE) - integer, parameter :: LEN_TIME = len(NETCDF_TIME) - integer, parameter :: LEN_DATETIME = len(NETCDF_DATETIME) - integer, parameter :: NUM_PARTS_UNITS_STRING = 4 - character(len=*), parameter :: TIME_UNITS(7) = & - [ 'years ', 'months ', 'days ', & - 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] - character, parameter :: SPACE = ' ' - type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN - character(len=*), parameter :: DIGIT_CHARS = '0123456789' - character, parameter :: PLUS = '+' - character, parameter :: MINUS = '-' - character(len=*), parameter :: SIGNS = PLUS // MINUS - character(len=*), parameter :: EMPTY_STRING = '' integer, parameter :: MAX_CHARACTER_LENGTH = 64 contains @@ -79,9 +36,9 @@ module MAPL_NetCDF ! Convert NetCDF_DateTime {int_time, units_string} to ! ESMF time variables {interval, time0, time1} and time unit {tunit} ! time0 is the start time, and time1 is time0 + interval - subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & - interval, time0, unusable, time1, tunit, rc) - integer, intent(in) :: int_time + subroutine convert_NetCDF_DateTime_to_ESMF_integer(duration, units_string, & + interval, time0, unusable, time1, tunit, rc) + integer, intent(in) :: duration character(len=*), intent(in) :: units_string type(ESMF_TimeInterval), intent(inout) :: interval type(ESMF_Time), intent(inout) :: time0 @@ -89,571 +46,80 @@ subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & type(ESMF_Time), optional, intent(inout) :: time1 character(len=:), allocatable, optional, intent(out) :: tunit integer, optional, intent(out) :: rc - character(len=:), allocatable :: tunit_ - character(len=len_trim(units_string)) :: parts(2) - character(len=len_trim(units_string)) :: head - character(len=len_trim(units_string)) :: tail - - integer :: span, factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(int_time >= 0, 'Negative span not supported') - _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') - - ! get time unit, tunit - parts = split(lr_trim(units_string), PART_DELIM) - head = parts(1) - tail = parts(2) - tunit_ = lr_trim(head) - _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') - if(present(tunit)) tunit = tunit_ - - ! get span - parts = split(lr_trim(tail), PART_DELIM) - head = parts(1) - tail = parts(2) - - factor = get_shift_sign(head) - _ASSERT(factor /= 0, 'Unrecognized preposition') - span = factor * int_time - - call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) - call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) - - ! get time1 - if(present(time1)) time1 = time0 + interval - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTime_to_ESMF - - ! Get NetCDF DateTime duration from ESMF_Time and units_string (integer) - subroutine get_NetCDF_duration_from_ESMF_Time_integer(time, units_string, duration, unusable, rc) - type(ESMF_Time), intent(inout) :: time - character(len=*), intent(in) :: units_string - integer, intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - character(len=MAX_CHARACTER_LENGTH) :: units - character(len=MAX_CHARACTER_LENGTH) :: preposition - character(len=MAX_CHARACTER_LENGTH) :: datetime_string - character(len=MAX_CHARACTER_LENGTH) :: remainder + class(CF_Time) :: cft + class(datetime_duration) :: dt_duration + character(len=MAX_CHARACTER_LENGTH) :: isostring + character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status - integer(ESMF_KIND_I8) :: sign_factor - - _UNUSED_DUMMY(unusable) - - _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - - call split(trim(units_string), units, remainder, PART_DELIM) - call split(trim(remainder), preposition, remainder, PART_DELIM) - datetime_string = trim(remainder) - - - call convert_NetCDF_DateTimeString_to_ESMF_Time(trim(datetime_string), start_time, _RC) - interval = time - start_time - call ESMF_TimeIntervalValidate(interval, rc = status) - _ASSERT(status == ESMF_SUCCESS, 'Invalid ESMF_TimeInterval') - - call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) - sign_factor = get_shift_sign(preposition) - _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - duration = sign_factor * duration - - _RETURN(_SUCCESS) - end subroutine get_NetCDF_duration_from_ESMF_Time_integer - - ! Get NetCDF DateTime duration from ESMF_Time and units_string (real) - subroutine get_NetCDF_duration_from_ESMF_Time_real(time, units_string, duration, unusable, rc) - type(ESMF_Time), intent(inout) :: time - character(len=:), allocatable, intent(in) :: units_string - real(kind=ESMF_KIND_R8), intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - character(len=MAX_CHARACTER_LENGTH) :: units - character(len=MAX_CHARACTER_LENGTH) :: preposition - character(len=MAX_CHARACTER_LENGTH) :: datetime_string - character(len=MAX_CHARACTER_LENGTH) :: remainder - integer :: status - integer(ESMF_KIND_I8) :: sign_factor - _UNUSED_DUMMY(unusable) - - _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - call split(trim(units_string), units, remainder, PART_DELIM) - call split(trim(remainder), preposition, remainder, PART_DELIM) - datetime_string = trim(remainder) + _ASSERT(duration >= 0, 'Negative span not supported') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) - interval = time - start_time + cft = CF_Time(duration, units_string) + call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) + call set_ESMF_TimeInterval(interval, cft, _RC) - call make_NetCDF_DateTime_duration(interval, start_time, units, duration, _RC) - sign_factor = get_shift_sign(preposition) - _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - duration = sign_factor * duration + call extract_ISO8601_from_CF_Time(cft, isostring, _RC) + call set_ESMF_Time_from_ISO8601(time0, isostring, _RC) - _RETURN(_SUCCESS) - - end subroutine get_NetCDF_duration_from_ESMF_Time_real - - ! Convert NetCDF datetime {units_string, duration (integer)} - ! into an ESMF_Time value representing the same datetime - subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, & - units_string, time, unusable, rc) - integer, intent(in) :: duration - character(len=*), intent(in) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), intent(inout) :: time - integer, optional, intent(out) :: rc - - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - character(len=MAX_CHARACTER_LENGTH) :: units - character(len=MAX_CHARACTER_LENGTH) :: preposition - character(len=MAX_CHARACTER_LENGTH) :: datetime_string - character(len=MAX_CHARACTER_LENGTH) :: remainder - integer :: signed_duration, sign_factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(duration >= 0, 'Negative duration not supported') - _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - - call split(trim(units_string), units, remainder, PART_DELIM) - call split(trim(remainder), preposition, remainder, PART_DELIM) - datetime_string = trim(remainder) - - sign_factor = get_shift_sign(preposition) - _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - signed_duration = sign_factor * duration - - call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) - call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) + if(present(time1)) time1 = time0 + interval - time = start_time + interval + if(present(tunit)) then + call extract_CF_Time_unit(cft, tunit_, _RC) + tunit = trim(tunit_) + end if _RETURN(_SUCCESS) - end subroutine get_ESMF_Time_from_NetCDF_DateTime_integer + end subroutine convert_NetCDF_DateTime_to_ESMF_integer - ! Convert NetCDF datetime {units_string, duration (real)} - ! into an ESMF_Time value representing the same datetime - subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, & - units_string, time, unusable, rc) - real(kind=ESMF_KIND_R8), intent(in) :: duration + ! Convert NetCDF_DateTime {real_time, units_string} to + ! ESMF time variables {interval, time0, time1} and time unit {tunit} + ! time0 is the start time, and time1 is time0 + interval + subroutine convert_NetCDF_DateTime_to_ESMF_real(duration, units_string, & + interval, time0, unusable, time1, tunit, rc) + real(kind=R64), intent(in) :: duration character(len=*), intent(in) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), intent(inout) :: time - integer, optional, intent(out) :: rc - - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - character(len=MAX_CHARACTER_LENGTH) :: units - character(len=MAX_CHARACTER_LENGTH) :: preposition - character(len=MAX_CHARACTER_LENGTH) :: datetime_string - character(len=MAX_CHARACTER_LENGTH) :: remainder - real(kind=ESMF_KIND_R8) :: signed_duration, sign_factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(duration >= 0, 'Negative duration not supported') - _ASSERT((len_trim(adjustl(units_string)) > 0), 'units_string empty') - - call split(trim(units_string), units, remainder, PART_DELIM) - call split(trim(remainder), preposition, remainder, PART_DELIM) - datetime_string = trim(remainder) - - sign_factor = get_shift_sign(preposition) - _ASSERT(sign_factor /= 0, 'Unrecognized preposition') - signed_duration = sign_factor * duration - - call convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, start_time, _RC) - call make_ESMF_TimeInterval(signed_duration, units, start_time, interval, _RC) - - time = start_time + interval - - _RETURN(_SUCCESS) - - end subroutine get_ESMF_Time_from_NetCDF_DateTime_real - -!======================= END HIGH-LEVEL PROCEDURES ========================= -!=============================================================================== -!========================= LOWER-LEVEL PROCEDURES ========================== - - ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior(datetime_string, datetime, unusable, rc) - character(len=*), intent(in) :: datetime_string - type(ESMF_Time), intent(inout) :: datetime - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - integer :: yy, mm, dd, h, m, s, i, j - character(len=4) :: part - character(len=:), allocatable :: msg - - _UNUSED_DUMMY(unusable) - - msg = 'Invalid datetime string: ' // datetime_string - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), msg) - - - i = 1 - j = i + 3 - part = datetime_string(i:j) - call convert_to_integer(part, yy, rc = status) - _ASSERT(status == 0, 'Unable to convert year string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, mm, rc = status) - _ASSERT(status == 0, 'Unable to convert month string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, dd, rc = status) - _ASSERT(status == 0, 'Unable to convert day string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, h, rc = status) - _ASSERT(status == 0, 'Unable to convert hour string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, m, rc = status) - _ASSERT(status == 0, 'Unable to convert minute string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, s, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time_prior - - ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) - character(len=*), intent(in) :: datetime_string - type(ESMF_Time), intent(inout) :: datetime - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - integer :: yy, mm, dd, h, m - real(kind=ESMF_KIND_R8) :: s_r8 - character(len=MAX_CHARACTER_LENGTH) :: part - character(len=MAX_CHARACTER_LENGTH) :: remainder - - _UNUSED_DUMMY(unusable) - - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid NetCDF datetime string') - - ! convert first 3 substrings to year, month, day - remainder = datetime_string - - call split(trim(remainder), part, remainder, DATE_DELIM) - call convert_to_integer(trim(part), yy, rc = status) - _ASSERT(status == 0, 'Unable to convert year string') - - call split(trim(remainder), part, remainder, DATE_DELIM) - call convert_to_integer(trim(part), mm, rc = status) - _ASSERT(status == 0, 'Unable to convert month string') - - call split(trim(remainder), part, remainder, PART_DELIM) - call convert_to_integer(trim(part), dd, rc = status) - _ASSERT(status == 0, 'Unable to convert day string') - - ! convert second 3 substrings to hour, minute, second - call split(trim(remainder), part, remainder, TIME_DELIM) - call convert_to_integer(part, h, rc = status) - _ASSERT(status == 0, 'Unable to convert hour string') - - call split(trim(remainder), part, remainder, TIME_DELIM) - call convert_to_integer(trim(part), m, rc = status) - _ASSERT(status == 0, 'Unable to convert minute string') - - part = remainder - call convert_to_real(trim(part), s_r8, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - - ! no need to call this unless datetime units are correct - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s_r8=s_r8, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time - - ! Make ESMF_TimeInterval from a span of time, time unit, and start time - subroutine make_ESMF_TimeInterval_integer(span, tunit, start_time, interval, unusable, rc) - integer, intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: start_time type(ESMF_TimeInterval), intent(inout) :: interval + type(ESMF_Time), intent(inout) :: time0 class (KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(inout) :: time1 + character(len=:), allocatable, optional, intent(out) :: tunit integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - select case(trim(adjustl(tunit))) - case('years') - call ESMF_TimeIntervalSet(interval, startTime=start_time, yy=span, _RC) - case('months') - call ESMF_TimeIntervalSet(interval, startTime=start_time, mm=span, _RC) - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=start_time, h=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=start_time, m=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=span, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_ESMF_TimeInterval_integer - - subroutine make_ESMF_TimeInterval_real(span, tunit, start_time, interval, unusable, rc) - real(kind=ESMF_KIND_R8), intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: start_time - type(ESMF_TimeInterval), intent(inout) :: interval - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - select case(trim(adjustl(tunit))) - case('years') - _FAIL('Real values for years are not supported.') - case('months') - _FAIL('Real values for months are not supported.') - case('days') - _FAIL('Real values for days are not supported.') - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=start_time, h_r8=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=start_time, m_r8=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=span, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_ESMF_TimeInterval_real - - ! Get time span from NetCDF datetime - ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (integer) - subroutine make_NetCDF_DateTime_duration_integer(interval, start_time, units, duration, unusable, rc) - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: start_time - character(len=*), intent(in) :: units - integer, intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - ! get duration - select case(trim(adjustl(units))) - case('years') - call ESMF_TimeIntervalGet(interval, start_time, yy=duration, _RC) - case('months') - call ESMF_TimeIntervalGet(interval, start_time, mm=duration, _RC) - case('hours') - call ESMF_TimeIntervalGet(interval, start_time, h=duration, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, start_time, m=duration, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, start_time, s=duration, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_duration_integer - ! Get time span from NetCDF datetime - ! Make NetCDF_DateTime duration from interval, start_time (ESMF_Time), and time units. (real) - subroutine make_NetCDF_DateTime_duration_real(interval, start_time, units, duration, unusable, rc) - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: start_time - character(len=*), intent(in) :: units - real(kind=ESMF_KIND_R8), intent(out) :: duration - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc + class(CF_Time) :: cft + class(datetime_duration) :: dt_duration + character(len=MAX_CHARACTER_LENGTH) :: isostring + character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status _UNUSED_DUMMY(unusable) - ! get duration - select case(trim(adjustl(units))) - case('years') - _FAIL('Real values for years are not supported.') - case('months') - _FAIL('Real values for months are not supported.') - case('days') - _FAIL('Real values for days are not supported.') - case('hours') - call ESMF_TimeIntervalGet(interval, start_time, h_r8=duration, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, start_time, m_r8=duration, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, start_time, s_r8=duration, _RC) - case default - _FAIL('Unrecognized unit') - end select + _ASSERT(duration >= 0, 'Negative span not supported') + _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_duration_real + cft = CF_Time(duration, units_string) + call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) + call set_ESMF_TimeInterval(interval, cft, _RC) -!======================= END LOWER-LEVEL PROCEDURES ======================== -!=============================================================================== -!============================= UTILITY PROCEDURES ============================== + call extract_ISO8601_from_CF_Time(cft, isostring, _RC) + call set_ESMF_Time_from_ISO8601(time0, isostring, _RC) - recursive function is_valid_netcdf_datetime_string(string) result(lval) - character(len=*), intent(in) :: string - logical :: lval - integer :: i - - lval = .false. - - i = index(string, POINT) - - if(i == 1) return + if(present(time1)) time1 = time0 + interval - if(i > 0) then - lval = is_valid_netcdf_datetime_string_real_seconds(string, i) - return + if(present(tunit)) then + call extract_CF_Time_unit(cft, tunit_, _RC) + tunit = trim(tunit_) end if - - if(len(trim(string)) /= len(NETCDF_DATETIME)) return - - do i=1, len_trim(string) - if(scan(NETCDF_DATETIME(i:i), DIGIT_CHARS) > 0) then - if(scan(string(i:i), DIGIT_CHARS) <= 0) return - else - if(string(i:i) /= NETCDF_DATETIME(i:i)) return - end if - end do - - lval = .true. - - end function is_valid_netcdf_datetime_string - - function is_valid_netcdf_datetime_string_real_seconds(string, i) result(lval) - character(len=*), intent(in) :: string - integer, intent(in) :: i - logical :: lval - - lval = is_valid_netcdf_datetime_string(string(1:(i-1))) .and. & - ((i == len(string)) .or. is_digit_string(string((i+1):))) - - end function is_valid_netcdf_datetime_string_real_seconds - ! Get the sign of integer represening a time span based on preposition - function get_shift_sign(preposition) - character(len=*), intent(in) :: preposition - integer :: get_shift_sign - integer, parameter :: POSITIVE = 1 - - get_shift_sign = 0 - if(adjustl(preposition) == 'since') get_shift_sign = POSITIVE - - end function get_shift_sign - - subroutine split_characters(characters, token, remainder, delimiters) - character(len=*), intent(in) :: characters - character(len=MAX_CHARACTER_LENGTH), intent(out) :: token - character(len=MAX_CHARACTER_LENGTH), intent(out) :: remainder - character(len=*), optional, intent(in) :: delimiters - character(len=:), allocatable :: delims - integer :: i - - delims = ' ' - if(present(delimiters)) delims = delimiters - - i = scan(characters, delims) - - if(i > 0) then - token = characters(:(i-1)) - remainder = characters((i+1):) - else - token = characters - remainder = EMPTY_STRING - endif - - end subroutine split_characters - - ! Convert string representing an integer to the integer - subroutine convert_to_integer(string, n, rc) - character(len=*), intent(in) :: string - integer, intent(out) :: n - integer, optional, intent(out) :: rc - integer :: stat - - n = -1 - read(string, '(I16)', iostat=stat) n - - if(present(rc)) rc = stat - - end subroutine convert_to_integer - - ! Convert string representing a real to a real(REAL64) - subroutine convert_to_real(string, t, rc) - character(len=*), intent(in) :: string - real(kind=ESMF_KIND_R8), intent(out) :: t - integer, optional, intent(out) :: rc - integer :: stat - - t = -1 - read(string, *, iostat=stat) t - - if(present(rc)) rc = stat - - end subroutine convert_to_real - - ! Check if string consists of only digit characters - function is_digit_string(string) - character(len=*), intent(in) :: string - logical :: is_digit_string - - is_digit_string = .FALSE. - if(len_trim(string) == 0) return - - is_digit_string = (verify(string(:len_trim(string)), DIGIT_CHARS) == 0) + _RETURN(_SUCCESS) - end function is_digit_string + end subroutine convert_NetCDF_DateTime_to_ESMF_real -!=========================== END UTILITY PROCEDURES ============================ +!======================= END HIGH-LEVEL PROCEDURES ========================= !=============================================================================== end module MAPL_NetCDF diff --git a/shared/CF_Time.F90 b/shared/CF_Time.F90 deleted file mode 100644 index cdae15a3d3e9..000000000000 --- a/shared/CF_Time.F90 +++ /dev/null @@ -1,20 +0,0 @@ -module CF_Time_mod - - use CF_Time_def_mod, only: CF_Time - use CF_Time_Integer_mod, only: construct_CF_Time_Integer, CF_Time_Integer - use CF_Time_Real_mod, only: construct_CF_Time_Real, CF_Time_Real - - implicit none - - private - - public :: CF_Time - public :: CF_Time_Integer - public :: CF_Time_Real - - interface CF_Time - module procedure :: construct_CF_Time_Integer - module procedure :: construct_CF_Time_Real - end interface CF_Time - -end module CF_Time_mod diff --git a/shared/CF_Time_Integer.F90 b/shared/CF_Time_Integer.F90 deleted file mode 100644 index 51c640a7a2b6..000000000000 --- a/shared/CF_Time_Integer.F90 +++ /dev/null @@ -1,38 +0,0 @@ -module CF_Time_Integer_mod - - use CF_Time_def_mod - - implicit none - - private - - public :: CF_Time_Integer - public :: construct_CF_Time_Integer - - type, extends(CF_Time) :: CF_Time_Integer - private - integer :: duration_ - contains - procedure, public, pass(this) :: duration => get_cf_time_duration_integer - end type CF_Time_Integer - -contains - - function construct_CF_Time_Integer(duration, units) result(cft) - integer, intent(in) :: duration - character(len=*), intent(in) :: units - type(CF_Time_Integer) :: cft - - cft % duration_ = duration - cft % units_ = units - - end function construct_CF_Time_Integer - - integer function get_cf_time_duration_integer(this) - class(CF_Time_Integer), intent(in) :: this - - get_cf_time_duration_integer = this % duration_ - - end function get_cf_time_duration_integer - -end module CF_Time_Integer_mod diff --git a/shared/CF_Time_Real.F90 b/shared/CF_Time_Real.F90 deleted file mode 100644 index 37f0a81c744f..000000000000 --- a/shared/CF_Time_Real.F90 +++ /dev/null @@ -1,38 +0,0 @@ -module CF_Time_Real_mod - - use CF_Time_def_mod - - implicit none - - private - - public :: CF_Time_Real - public :: construct_CF_Time_Real - - type, extends(CF_Time) :: CF_Time_Real - private - real :: duration_ - contains - procedure, public, pass(this) :: duration => get_cf_time_duration_real - end type CF_Time_Integer - -contains - - function construct_CF_Time_Real(duration, units) result(cft) - integer, intent(in) :: duration - character(len=*), intent(in) :: units - type(CF_Time_Integer) :: cft - - cft % duration_ = duration - cft % units_ = units - - end function construct_CF_Time_Real - - real function get_cf_time_duration_real(this) - class(CF_Time_Integer), intent(in) :: this - - get_cf_time_duration_integer = this % duration_ - - end function get_cf_time_duration_real - -end module CF_Time_Real_mod diff --git a/shared/CF_Time_def.F90 b/shared/CF_Time_def.F90 deleted file mode 100644 index 3d1c2355732d..000000000000 --- a/shared/CF_Time_def.F90 +++ /dev/null @@ -1,27 +0,0 @@ -module CF_Time_def_mod - - implicit none - - private - - public :: CF_Time - - type, abstract :: CF_Time - private - character(len=:), allocatable :: units_ - contains - procedure, public, pass(this) :: units => get_cf_time_units - procedure, deferred, public, pass(this) :: duration - end type CF_Time - -contains - - function get_cf_time_units(this) result(units) - class(CF_Time), intent(in) :: this - character(len=:), allocatable :: units - - units = this % units_ - - end function get_cf_time_units - -end module CF_Time_def_mod diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 46389b996a12..8572a65f2502 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -29,6 +29,7 @@ set (srcs DownBit.F90 ShaveMantissa.c MAPL_Sleep.F90 + MAPL_CF_Time.F90 # Fortran submodules Interp/Interp.F90 Interp/Interp_implementation.F90 Shmem/Shmem.F90 Shmem/Shmem_implementation.F90 diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 index c93e4288a7bb..a7d0ce9d9949 100644 --- a/shared/MAPL_CF_Time.F90 +++ b/shared/MAPL_CF_Time.F90 @@ -2,6 +2,7 @@ #include "MAPL_ErrLog.h" module MAPL_CF_Time + use, intrinsic :: iso_fortran_env, only : R64 => real64 use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_DateTime_Parsing @@ -11,11 +12,10 @@ module MAPL_CF_Time ! Comment to test all procedures private - ! PUBLIC PROCEDURES (ACCESS): public :: extract_ISO8601_from_CF_Time public :: extract_CF_Time_duration - public :: extract_CF_Time_units + public :: extract_CF_Time_unit public :: convert_CF_Time_to_datetime_duration ! Convert ISO8601 datetime string to CF_Time_base_datetime public :: convert_ISO8601_to_CF_Time_base_datetime @@ -61,7 +61,6 @@ module MAPL_CF_Time ! CF_TIME: derived type to hold the data for CF Time values type, abstract :: CF_Time - public logical :: is_valid character(len=:), allocatable :: time_unit character(len=:), allocatable :: base_datetime @@ -70,12 +69,10 @@ module MAPL_CF_Time end type CF_Time type, extends(CF_Time) :: CF_Time_Integer - public integer :: duration end type CF_Time_Integer type, extends(CF_Time) :: CF_Time_Real - public real(kind=R64) :: duration end type CF_Time_Real @@ -93,8 +90,9 @@ module MAPL_CF_Time character, parameter :: TIME_DELIM = ':' character, parameter :: ISO_DELIM = 'T' character(len=2), parameter :: CF_DELIM = ' ' // ISO_DELIM - character(len=*), parameter = EMPTY_STRING = '' - + character(len=*), parameter :: EMPTY_STRING = '' + character, parameter :: DECIMAL_POINT = '.' + character(len=*), parameter :: DIGIT_CHARACTERS = '1234567890' contains @@ -114,7 +112,7 @@ subroutine extract_ISO8601_from_CF_Time_units(units, isostring, rc) end subroutine extract_ISO8601_from_CF_Time_units - function extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) + subroutine extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) class(CF_Time), intent(in) :: cft character(len=MAX_CHARACTER_LENGTH), intent(out) :: isostring integer, optional, intent(out) :: rc @@ -122,11 +120,11 @@ function extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) call cft % check(_RC) - call convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime, isostring, _RC) + isostring = convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime) _RETURN(_SUCCESS) - end function extract_ISO8601_from_CF_Time_cf_time + end subroutine extract_ISO8601_from_CF_Time_cf_time subroutine extract_CF_Time_duration_cf_time_real(cft, duration, rc) class(CF_Time_Real), intent(in) :: cft @@ -160,10 +158,11 @@ subroutine extract_CF_Time_unit_cf_time(cft, time_unit, rc) class(CF_Time), intent(in) :: cft character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit integer, optional, intent(out) :: rc + integer :: status call cft % check(_RC) - time_units = cft % time_unit + time_unit = cft % time_unit _RETURN(_SUCCESS) @@ -174,23 +173,12 @@ subroutine extract_CF_Time_unit_units(units, time_unit, rc) character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit integer, optional, intent(out) :: rc - call extract_CF_Time_units(CF_Time(0, units), time_units, _RC) + call extract_CF_Time_unit(CF_Time(0, units), time_unit, _RC) _RETURN(_SUCCESS) end subroutine extract_CF_Time_unit_units - subroutine convert_ISO8601_to_CF_Time_datestring(isostring, datestring, rc) - character(len=*), intent(in) :: isostring - character(len=MAX_CHARACTER_LENGTH), intent(out) :: datestring - integer, optional, intent(out) :: rc - - datestring = remove_zero_pad(isostring) - - _RETURN(_SUCCESS) - - end subroutine convert_ISO8601_to_CF_Time_datestring - subroutine convert_CF_Time_to_datetime_duration_integer(cft, dt_duration, rc) class(CF_Time_Integer), intent(in) :: cft type(datetime_duration), intent(out) :: dt_duration @@ -220,7 +208,7 @@ subroutine convert_CF_Time_to_datetime_duration_real(cft, dt_duration, rc) call cft % check(_RC) - tu = time_unit(cft % time_units()) + tu = get_time_unit(cft % time_units()) if(tu == TIME_UNIT_UNKNOWN) then _FAIL('Unrecognized time unit in CF Time') endif @@ -262,10 +250,10 @@ function convert_CF_Time_datetime_string_to_ISO8601(datetime_string) result(isod character(len=MAX_CHARACTER_LENGTH) :: isodatetime character(len=MAX_CHARACTER_LENGTH) :: remainder ! parts [year, month, day, hour, minute, second) - character(len=MAX_CHARACTER_LENGTH) :: part(NUM_CF_TIME_UNITS) - character(len=MAX_CHARACTER_LENGTH) :: delimiters(NUM_CF_TIME_UNITS) + character(len=MAX_CHARACTER_LENGTH) :: part(NUM_TIME_UNITS) + character(len=MAX_CHARACTER_LENGTH) :: delimiters(NUM_TIME_UNITS) - datetime = EMPTY_STRING + isodatetime = EMPTY_STRING remainder = datetime_string call split(trim(remainder), part(YEAR), remainder, DATE_DELIM) @@ -300,6 +288,15 @@ end subroutine update_datetime end function convert_CF_Time_datetime_string_to_ISO8601 + function convert_ISO8601_to_CF_Time_base_datetime(isostring) result(base_datetime) + character(len=*), intent(in) :: isostring + character(len=len(isostring)) :: base_datetime + + base_datetime = remove_zero_pad(isostring) + base_datetime = substitute(base_datetime, 'T', ' ') + + end function convert_ISO8601_to_CF_Time_base_datetime + ! END PUBLIC PROCEDURES (DEFINITION) @@ -310,37 +307,33 @@ end function convert_CF_Time_datetime_string_to_ISO8601 function construct_cf_time_integer(duration, units) result (cft) integer, intent(in) :: duration character(len=*), intent(in) :: units - type(CF_Time) :: cft + type(CF_Time_Integer) :: cft integer :: status if(duration < 0) return - call cft % initialize_cf_time(units, rc=status) - cft % duration = duration - - cft % valid = status + call initialize_cf_time(cft, units, rc=status) + cft % is_valid = status end function construct_cf_time_integer function construct_cf_time_real(duration, units) result (cft) real(kind=R64), intent(in) :: duration character(len=*), intent(in) :: units - type(CF_Time) :: cft + type(CF_Time_Real) :: cft integer :: status if(duration < 0) return - call cft % initialize_cf_time(units, rc=status) - cft % duration = duration - - cft % valid = status + call initialize_cf_time(cft, units, rc=status) + cft % is_valid = status end function construct_cf_time_real - subroutine initialize_cf_time(this, units, rc) - class(CF_time), intent(inout) :: this + subroutine initialize_cf_time(cft, units, rc) + class(CF_Time), intent(inout) :: cft character(len=*), intent(in) :: units integer, optional, intent(out) :: rc character(len=MAX_CHARACTER_LENGTH) :: token(2), remainder @@ -418,27 +411,123 @@ subroutine split_characters(characters, token, remainder, delimiters) end subroutine split_characters -! REMOVE_ZERO_PAD - UTILITY - function remove_zero_pad(s) result(u) - character(len=*), intent(in) :: s - character(len=len(string)) :: u - character :: c - integer :: i, n - logical :: follows(len(s)) - integer, allocatable :: indices - - indices = .not. findloc((follows_digit(s) .and. (s == '0')), .TRUE.) - u = s(indices) +! UTILITIES + + function remove_zero_pad(isostring) result(unpadded) + character(len=*), intent(in) :: isostring + character(len=len(isostring)) :: unpadded + character(len=DT_PART_WIDTH) :: part(NUM_DT_PARTS) + character(len=len(isostring)) :: fraction_part + integer :: i + + part = get_ISO8601_substrings(isostring) + fraction_part = get_ISO8601_fractional_seconds(isostring) + unpadded = trim(part(1)) + do i = 2, size(part) + part(i) = strip_zero(part(i)) + unpadded = trim(unpadded) // trim(part(i)) + end do + + fraction_part = strip_zero(fraction_part, back = .TRUE.) + if(len_trim(fraction_part) > 0) unpadded = trim(unpadded) // DECIMAL_POINT // trim(fraction_part) + end function remove_zero_pad + + function substitute(string, ch1, ch2) result(replaced) + character(len=*), intent(in) :: string + character, intent(in) :: ch1, ch2 + character(len=len(string)) :: replaced + integer :: i, j + + j = 0 + replaced = string + i = index(replaced((j+1):), ch1) + do while (i > 0) + j = j + i + if(j > len(replaced)) exit + replaced(j:j) = ch2 + if(j == len(replaced)) exit + i = index(replaced((j+1):), ch1) + end do + + end function substitute -! FOLLOWS_DIGIT - UTILITY - function follows_digit(s) result(follows) - character(len=*), intent(in) :: s - logical :: follows(len(s)) + elemental logical function is_zero(ch) + character, intent(in) :: ch + is_zero = (ch == '0') + end function is_zero + + function get_ISO8601_substrings(isostring) result(substring) + character(len=*), intent(in) :: isostring + integer, parameter :: NUM_DT_PARTS = 6 + integer, parameter :: DT_PART_WIDTH = 5 + character(len=DT_PART_WIDTH) :: substring(NUM_DT_PARTS) + + substring = EMPTY_STRING + + substring(1) = isostring(1:5) + substring(2) = isostring(6:8) + substring(3) = isostring(9:11) + substring(4) = isostring(12:14) + substring(5) = isostring(15:17) + substring(6) = isostring(18:19) - follows(1) = .FALSE. - follows(2:) = is_digit(1:(len(s)-1)) + end function get_ISO8601_substrings + + function get_ISO8601_fractional_seconds(isostring) result(fs) + character(len=*), intent(in) :: isostring + integer, parameter :: FIRST_INDEX = 20 + character(len=len(isostring)) :: fs + integer :: i, j + + fs = EMPTY_STRING + if(len_trim(isostring) < FIRST_INDEX) return + i = FIRST_INDEX + if(isostring(i:i) /= DECIMAL_POINT) return + i = i + 1 + j = verify(isostring(i:), DIGIT_CHARACTERS) + select case(j) + case(0) + fs = isostring(i:) + case(1) + return + case default + j = j + i - 2 + fs = isostring(i:j) + end select + + end function get_ISO8601_fractional_seconds + + function strip_zero(string, back) result(stripped) + character(len=*), intent(in) :: string + logical, optional, intent(in) :: back + character(len=len(string)) :: stripped + logical :: back_ + integer :: i, j, k, n + character :: ch + + stripped = EMPTY_STRING + back_ = .FALSE. + if(present(back)) back_ = back + + n = len_trim(string) + if(back_) then + i = 1 + do j = n, i, -1 + ch = string(j:j) + if(.not. is_zero(ch)) exit + end do + else + j = n + do i = 1, n + ch = string(i:i) + if(.not. is_zero(ch)) exit + end do + i = min(i, j) + end if + + stripped = string(i:j) + + end function strip_zero - end function follows_digit - end module MAPL_CF_Time diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 9bebbc26d07f..d3a001da7d78 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -53,8 +53,13 @@ module MAPL_DateTime_Parsing public :: datetime_duration public :: convert_to_ISO8601DateTime public :: is_digit + public :: is_digit_string public :: is_positive_digit public :: MAX_CHARACTER_LENGTH + public :: is_time_unit + + public :: YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, TIME_UNIT_UNKNOWN + public :: TIME_UNIT, NUM_TIME_UNITS ! private @@ -140,6 +145,7 @@ module MAPL_DateTime_Parsing real(kind=R64) :: hour_real, minute_real, second_real logical :: hour_is_set, minute_is_set, second_is_set logical :: year_is_set, month_is_set, day_is_set + logical :: hour_is_real, minute_is_real, second_is_real contains procedure, pass(this) :: set_year => set_year_datetime_duration procedure, pass(this) :: set_month => set_month_datetime_duration @@ -229,6 +235,15 @@ elemental pure logical function is_digit(c) is_digit = scan(c, DIGIT_CHARACTERS) > 0 end function is_digit + ! Check is s is a digit-only string + logical function is_digit_string(s) + character(len=*), intent(in) :: s + + is_digit_string = (len_trim(s) > 0) .and. & + (verify(s(:len_trim(s)), DIGIT_CHARACTERS) == 0) + + end function is_digit_string + ! Check if c is a positive digit character elemental pure logical function is_positive_digit(c) character, intent(in) :: c @@ -757,6 +772,10 @@ function construct_datetime_duration() result(that) that % minute_is_set = .FALSE. that % second_is_set = .FALSE. + that % hour_is_real = .FALSE. + that % minute_is_real = .FALSE. + that % second_is_real = .FALSE. + end function construct_datetime_duration ! END CONSTRUCTORS @@ -872,7 +891,7 @@ subroutine set_hour_datetime_duration(this, val, rc) end if this % hour = val - this % hour_is_set = .FALSE. + this % hour_is_set = .TRUE. _RETURN(_SUCCESS) @@ -889,7 +908,8 @@ subroutine set_hour_real_datetime_duration(this, val, rc) end if this % hour_real = val - this % hour_is_set = .FALSE. + this % hour_is_set = .TRUE. + this % hour_is_real = .TRUE. _RETURN(_SUCCESS) @@ -906,7 +926,7 @@ subroutine set_minute_datetime_duration(this, val, rc) end if this % minute = val - this % minute_is_set = .FALSE. + this % minute_is_set = .TRUE. _RETURN(_SUCCESS) @@ -923,7 +943,8 @@ subroutine set_minute_real_datetime_duration(this, val, rc) end if this % minute_real = val - this % minute_is_set = .FALSE. + this % minute_is_set = .TRUE. + this % minute_is_real = .TRUE. _RETURN(_SUCCESS) @@ -940,7 +961,7 @@ subroutine set_second_datetime_duration(this, val, rc) end if this % second = val - this % second_is_set = .FALSE. + this % second_is_set = .TRUE. _RETURN(_SUCCESS) @@ -957,7 +978,8 @@ subroutine set_second_real_datetime_duration(this, val, rc) end if this % second_real = val - this % second_is_set = .FALSE. + this % second_is_set = .TRUE. + this % second_is_real = .TRUE. _RETURN(_SUCCESS) @@ -987,6 +1009,8 @@ subroutine set_integer_value_datetime_duration(this, tunit, val, rc) _FAIL('Invalid Time Unit') end select + _RETURN(_SUCCESS) + end subroutine set_integer_value_datetime_duration subroutine set_real_value_datetime_duration(this, tunit, val, rc) @@ -1007,6 +1031,8 @@ subroutine set_real_value_datetime_duration(this, tunit, val, rc) _FAIL('Invalid Time Unit') end select + _RETURN(_SUCCESS) + end subroutine set_real_value_datetime_duration ! END CF Time: Type-bound procedues @@ -1203,7 +1229,6 @@ function convert_lengths_to_indices(length) result(indices) end function convert_lengths_to_indices - ! TIME_UNIT ==================================================================== function get_time_unit(unit_name, check_plural) result(n) @@ -1212,10 +1237,11 @@ function get_time_unit(unit_name, check_plural) result(n) character(len=:), allocatable :: unit_name_ logical :: check_plural_ = .TRUE. character(len=:), pointer, save :: tunits(:) - character(len=:), allocatable :: tunit, unit_name_plural + character(len=:), allocatable :: tunit character, parameter :: PLURAL = 's' integer :: n, i + check_plural_ = .TRUE. if(present(check_plural)) check_plural_ = check_plural unit_name_ = trim(unit_name) tunits = get_time_units() @@ -1251,4 +1277,9 @@ end function get_time_units end function get_time_unit + logical function is_time_unit(string) + character(len=*), intent(in) :: string + is_time_unit = (get_time_unit(string) /= TIME_UNIT_UNKNOWN) + end function is_time_unit + end module MAPL_DateTime_Parsing diff --git a/shared/MAPL_ISO8601_DateTime.F90 b/shared/MAPL_ISO8601_DateTime.F90 index 58816b391042..0ad4f3bfb4d2 100644 --- a/shared/MAPL_ISO8601_DateTime.F90 +++ b/shared/MAPL_ISO8601_DateTime.F90 @@ -674,6 +674,9 @@ function construct_ISO8601Date(isostring, rc) result(date) else _FAIL('Invalid ISO 8601 date string') end if + + _RETURN(_SUCCESS) + end function construct_ISO8601Date function construct_ISO8601Time(isostring, rc) result(time) @@ -693,6 +696,9 @@ function construct_ISO8601Time(isostring, rc) result(time) else _FAIL('Invalid ISO 8601 time string') end if + + _RETURN(_SUCCESS) + end function construct_ISO8601Time function construct_ISO8601DateTime(isostring, rc) result(datetime) From 528baf82bd40317c2d3e90182f7fc3aa96613f08 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 15 Aug 2023 15:29:55 -0400 Subject: [PATCH 17/32] Remove MAPL_CF_Units.F90 (used with CF_Time_* modules --- shared/MAPL_CF_Units.F90 | 99 ---------------------------------------- 1 file changed, 99 deletions(-) delete mode 100644 shared/MAPL_CF_Units.F90 diff --git a/shared/MAPL_CF_Units.F90 b/shared/MAPL_CF_Units.F90 deleted file mode 100644 index 46a025a3f9e4..000000000000 --- a/shared/MAPL_CF_Units.F90 +++ /dev/null @@ -1,99 +0,0 @@ -module MAPL_CF_Units - - use CF_Time_mod - - implicit none - - private - - public :: convert_cf_time_to_iso8601, convert_iso8601_to_cf_time_real, convert_iso8601_to_cf_time_integer - - interface convert_cf_time_to_iso8601 - module procedure :: convert_cf_time_to_iso8601_integer - module procedure :: convert_cf_time_to_iso8601_real - module procedure :: convert_cf_time_to_iso8601_dt - end interface convert_cf_time_to_iso8601 - - character(len=*), parameter :: FRAC_DELIM = '.' - character(len=*), parameter :: TIME_DELIM = ':' - character(len=*), parameter :: DATE_DELIM = '-' - character(len=*), parameter :: DT_DELIM = ' T' - -contains - - subroutine convert_cf_time_to_iso8601_integer(duration, units, isotime, rc) - integer, intent(in) :: duration - character(len=*), intent(in) :: units - character(len=:), allocatable, intent(out) :: isotime - integer, optional, intent(out) :: rc - integer :: status - - end subroutine convert_cf_time_to_iso8601_integer - - subroutine convert_cf_time_to_iso8601_real(duration, units, isotime, rc) - real, intent(in) :: duration - character(len=*), intent(in) :: units - character(len=:), allocatable, intent(out) :: isotime - real, optional, intent(out) :: rc - integer :: status - end subroutine convert_cf_time_to_iso8601_real - - subroutine convert_cf_time_to_iso8601_dt(cftime, isotime, rc) - class(CF_Time), intent(in) :: cftime - character(len=:), allocatable, intent(out) :: isotime - real, optional, intent(out) :: rc - integer :: status - - call convert_cf_time_to_iso8601(cftime % duration(), cftime % units(), isotime, _RC) - - end subroutine convert_cf_time_to_iso8601_dt - - subroutine convert_iso8601_to_cf_time(isotime, cftime, rc) - character(len=*), intent(in) :: isotime - type(CF_Time_Real), intent(out) :: cftime - integer, optional, intent(out) :: rc - character(len=4) :: year - character(len=2) :: month - character(len=2) :: day - character(len=2) :: hour - character(len=2) :: minute - character(len=2) :: second - character(len=:), allocatable :: second_fraction - - - end subroutine convert_iso8601_to_cf_time - - subroutine convert_iso8601_to_cf_time_integer(isotime, cftime, rc) - character(len=*), intent(in) :: isotime - type(CF_Time_Integer), intent(out) :: cftime - integer, optional, intent(out) :: rc - class(CF_Time_Real) :: cftime_real - integer :: status - - call convert_iso8601_to_cf_time(isotime, cftime_real, _RC) - cftime = CF_Time(integer(cftime_real % duration()), cftime_real % units(), _RC) - - end subroutine convert_iso8601_to_cf_time_integer - - function make_CF_Time_reference(parts, zero_pad, cft_ref) result(cft_ref) - character(len=*), intent(in) :: year - character(len=*), intent(in) :: month - character(len=*), intent(in) :: day - character(len=*), intent(in) :: hour - character(len=*), intent(in) :: minute - character(len=*), intent(in) :: second - character(len=*), intent(in) :: second_fraction - logical, optional, intent(in) :: zero_pad - logical, optional, intent(in) :: use_t - character(len=:), allocatable :: cft_ref - end function make_CF_Time_reference - -end module MAPL_CF_Units - -module CF_Time_def_mod - - implicit none - - private - - public :: CF_Time From 2df8ad9acad6ed186b65563a64a80fe179a3ddbd Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 15 Aug 2023 16:20:07 -0400 Subject: [PATCH 18/32] Update MAPL_NetCDF tests for updated version --- base/tests/CMakeLists.txt | 5 -- base/tests/test_MAPL_NetCDF.pf | 129 +++++++++++---------------------- 2 files changed, 43 insertions(+), 91 deletions(-) diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index f0d7c31c78a7..ef60a2822506 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -1,9 +1,6 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.base/tests") add_definitions(-DUSE_MPI) -# uncomment test_mapl_netcdf_private.pf to test private MAPL_NetCDF procedures -# as well as the helper procedures used by test_MAPL_NetCDF and test_MAPL_NetCDF_private -# make sure to make the private procedures in MAPL_NetCDF public (uncomment the 'public' statements). set (TEST_SRCS # test_Mapl_Base.pf # test_sort.pf @@ -18,8 +15,6 @@ set (TEST_SRCS # test_DirPath.pf # test_TimeStringConversion.pf test_MAPL_NetCDF.pf - test_MAPL_NetCDF_helpers.F90 - test_MAPL_NetCDF_private.pf # test_MAPL_ISO8601_DateTime_ESMF.pf ) diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 28f4fb078849..93d034b1e435 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -27,80 +27,33 @@ contains end subroutine set_up - @Test - subroutine test_get_NetCDF_duration_from_ESMF_Time_integer() - type(ESMF_Time) :: time - character(len=:), allocatable :: units_string - integer :: duration, expected_duration - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - integer :: yy, mm, dd, h, m, s, m_time - integer :: status - - yy = 1999 - mm = 12 - dd = 31 - h = 23 - m = 29 - m_time = 59 - s = 59 - units = 'seconds' - preposition = 'since' - expected_duration = (m_time - m) * SECONDS_PER_MINUTE - - units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') - - call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create ESMF_Time') - - call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) - @assertTrue(status == SUCCESS, 'Failed to get duration time') - @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') - - end subroutine test_get_NetCDF_duration_from_ESMF_Time_integer - - @Test - subroutine test_get_NetCDF_duration_from_ESMF_Time_real() - type(ESMF_Time) :: time - character(len=:), allocatable :: units_string - real(kind=ESMF_KIND_R8) :: duration, expected_duration - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - integer :: yy, mm, dd, h, m, s, m_time + function ESMF_Times_Equal(timeu, timev) result(tval) + type(ESMF_Time), intent(in) :: timeu, timev + logical :: tval + integer :: uyy, umm, udd, uh, um, us, usN, usD + integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD integer :: status - yy = 1999 - mm = 12 - dd = 31 - h = 23 - m = 29 - m_time = 59 - s = 59 - units = 'seconds' - preposition = 'since' - expected_duration = (m_time - m) * SECONDS_PER_MINUTE - - units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + tval = .FALSE. + call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) + if(status /= SUCCESS) return + call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) + if(status /= SUCCESS) return - call ESMF_TimeSet(time, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create time') + tval = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & + .and. (uh == vh) .and. (um == vm) .and. (us == vs) & + .and. rational_equals([usN, usD], [vsN, vsD]) ) - call get_NetCDF_duration_from_ESMF_Time(time, units_string, duration, rc=status) - @assertTrue(status == SUCCESS, 'Failed to get duration time') - @assertEqual(expected_duration, duration, 'Actual duration does not match expected duration.') - - end subroutine test_get_NetCDF_duration_from_ESMF_Time_real + end function ESMF_Times_Equal @Test - subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer() + subroutine test_convert_NetCDF_DateTime_to_ESMF_integer() integer :: duration integer :: yy, mm, dd, h, m, s, m_time - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=:), allocatable :: units_string - type(ESMF_Time) :: time, etime + character(len=*), parameter :: UNITS = 'seconds' + character(len=:), allocatable :: tunit + type(ESMF_Time) :: time, etime, btime + type(ESMF_TimeInterval) :: time_interval integer :: status yy = 1999 @@ -110,31 +63,33 @@ contains m = 29 m_time = 59 s = 59 - units = 'seconds' - preposition = 'since' duration = ( m_time - m ) * SECONDS_PER_MINUTE - - units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, "Failed to make units_string") + units_string = UNITS // ' since 1999-12-31 23:29:59' call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + @assertTrue(status == SUCCESS, 'Unable to create expected base ESMF_Time') - call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & + time1 = time, tunit = tunit, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') + @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") + + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') - end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_integer + end subroutine test_convert_NetCDF_DateTime_to_ESMF_integer @Test - subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real() + subroutine test_convert_NetCDF_DateTime_to_ESMF_real() real(kind=ESMF_KIND_R8) :: duration integer :: yy, mm, dd, h, m, s, m_time - character(len=:), allocatable :: units - character(len=:), allocatable :: preposition - character(len=:), allocatable :: units_string - type(ESMF_Time) :: time, etime + character(len=*), parameter :: UNITS = 'seconds' + character(len=:), allocatable :: tunit + type(ESMF_Time) :: time, etime, btime + type(ESMF_TimeInterval) :: time_interval integer :: status yy = 1999 @@ -144,21 +99,23 @@ contains m = 29 m_time = 59 s = 59 - units = 'seconds' - preposition = 'since' duration = ( m_time - m ) * SECONDS_PER_MINUTE - - units_string = make_units_string(units, preposition, yy, mm, dd, h, m, s) - @assertTrue(len_trim(units_string) > 0, 'Failed to make units_string') + units_string = UNITS // ' since 1999-12-31 23:29:59' call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') - call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time, rc = status) + call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & + time1 = time, tunit = tunit, rc = status) @assertTrue(status == SUCCESS, 'Conversion failed') + @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") + + call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') - end subroutine test_get_ESMF_Time_from_NetCDF_DateTime_real + end subroutine test_convert_NetCDF_DateTime_to_ESMF_real end module test_MAPL_NetCDF From 635a57c01b5355f2bb05301bce8c08539b2e63c7 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 15 Aug 2023 16:54:34 -0400 Subject: [PATCH 19/32] Remove unintended files from index --- Testing/Temporary/CTestCostData.txt | 1 - Testing/Temporary/LastTest.log | 3 - base/tests/CMakeLists.txt | 22 +- base/tests/CMakeLists.txt.bak | 70 ----- copy_mapl_netcdf | 449 ---------------------------- 5 files changed, 11 insertions(+), 534 deletions(-) delete mode 100644 Testing/Temporary/CTestCostData.txt delete mode 100644 Testing/Temporary/LastTest.log delete mode 100644 base/tests/CMakeLists.txt.bak delete mode 100644 copy_mapl_netcdf diff --git a/Testing/Temporary/CTestCostData.txt b/Testing/Temporary/CTestCostData.txt deleted file mode 100644 index ed97d539c095..000000000000 --- a/Testing/Temporary/CTestCostData.txt +++ /dev/null @@ -1 +0,0 @@ ---- diff --git a/Testing/Temporary/LastTest.log b/Testing/Temporary/LastTest.log deleted file mode 100644 index 9b6d6b15b0dd..000000000000 --- a/Testing/Temporary/LastTest.log +++ /dev/null @@ -1,3 +0,0 @@ -Start testing: Jun 14 10:33 EDT ----------------------------------------------------------- -End testing: Jun 14 10:33 EDT diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index ef60a2822506..5d7469ce6716 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -2,18 +2,18 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.base/tests") add_definitions(-DUSE_MPI) set (TEST_SRCS -# test_Mapl_Base.pf -# test_sort.pf + test_Mapl_Base.pf + test_sort.pf # Test_CFIO_Bundle.pf -# Test_SimpleMAPLcomp.pf -# Test_StringGridFactoryMap.pf -# Test_GridManager.pf -# Test_LatLon_GridFactory.pf -# Test_SphericalToCartesian.pf -# Test_LatLon_Corners.pf -# Test_MAPL_Config.pf -# test_DirPath.pf -# test_TimeStringConversion.pf + Test_SimpleMAPLcomp.pf + Test_StringGridFactoryMap.pf + Test_GridManager.pf + Test_LatLon_GridFactory.pf + Test_SphericalToCartesian.pf + Test_LatLon_Corners.pf + Test_MAPL_Config.pf + test_DirPath.pf + test_TimeStringConversion.pf test_MAPL_NetCDF.pf # test_MAPL_ISO8601_DateTime_ESMF.pf ) diff --git a/base/tests/CMakeLists.txt.bak b/base/tests/CMakeLists.txt.bak deleted file mode 100644 index 433c052c70e5..000000000000 --- a/base/tests/CMakeLists.txt.bak +++ /dev/null @@ -1,70 +0,0 @@ -set(MODULE_DIRECTORY "${esma_include}/MAPL.base/tests") - -add_definitions(-DUSE_MPI) -# uncomment test_mapl_netcdf_private.pf to test private MAPL_NetCDF procedures -# as well as the helper procedures used by test_MAPL_NetCDF and test_MAPL_NetCDF_private -# make sure to make the private procedures in MAPL_NetCDF public (uncomment the 'public' statements). -set (TEST_SRCS - test_Mapl_Base.pf - test_sort.pf -# Test_CFIO_Bundle.pf - Test_SimpleMAPLcomp.pf - Test_StringGridFactoryMap.pf - Test_GridManager.pf - Test_LatLon_GridFactory.pf - Test_SphericalToCartesian.pf - Test_LatLon_Corners.pf - Test_MAPL_Config.pf - test_DirPath.pf - test_TimeStringConversion.pf -# test_MAPL_NetCDF.pf - test_MAPL_NetCDF_helpers.F90 -# test_MAPL_NetCDF_private.pf -# test_MAPL_ISO8601_DateTime_ESMF.pf - ) - -# SRCS are mostly mocks to facilitate tests -set (SRCS - MockGridFactory.F90 - MockRegridder.F90 - ) - -# This file needs to be in a library because CMake cannot detect the -# dependency of the pFUnit driver on it. This is due to the use of -# preprocesor in the driver for specifying the include file. -#add_library (base_extras -# MAPL_Initialize.F90 -# ) -#target_link_libraries (base_extras MAPL.shared MAPL.pfunit -# esmf NetCDF::NetCDF_Fortran) - -add_pfunit_ctest(MAPL.base.tests - TEST_SOURCES ${TEST_SRCS} - OTHER_SOURCES ${SRCS} -# LINK_LIBRARIES MAPL.base MAPL.shared MAPL.pfio base_extras MAPL.pfunit - LINK_LIBRARIES MAPL.base MAPL.shared MAPL.constants MAPL.pfio MAPL.pfunit - EXTRA_INITIALIZE Initialize - EXTRA_USE MAPL_pFUnit_Initialize - MAX_PES 8 - ) -set_target_properties(MAPL.base.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -add_dependencies(build-tests MAPL.base.tests) - -set(TESTIO mapl_bundleio_test.x) -ecbuild_add_executable ( - TARGET ${TESTIO} - NOINSTALL - SOURCES mapl_bundleio_test.F90 - LIBS MAPL.base MAPL.shared MAPL.constants MAPL.pfio MAPL.griddedio NetCDF::NetCDF_Fortran MPI::MPI_Fortran - DEFINITIONS USE_MPI) -set_target_properties(${TESTIO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - -add_test(NAME bundleio_tests_latlon - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 2 -ny 1 -ogrid PC90x47-DE -o file1_ll.nc4) - -add_test(NAME bundleio_tests_cube - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 6 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 1 -ny 6 -ogrid PE12x72-CF -o file_cs.nc4) - -add_dependencies(build-tests ${TESTIO}) - diff --git a/copy_mapl_netcdf b/copy_mapl_netcdf deleted file mode 100644 index 8b5f0ea0f397..000000000000 --- a/copy_mapl_netcdf +++ /dev/null @@ -1,449 +0,0 @@ -!wdb todo -!subroutine to convert -!From: integer: array(2) = [ 20010101 010101 (HHMMSS) ] ![ (YYYYMMDD) (HHMMSS) ] -!To: !ESMF_TIME: with gregorian calendar -!And vice versa. -#include "MAPL_Exceptions.h" -#include "MAPL_ErrLog.h" -! Procedures to convert from NetCDF datetime to ESMF_Time and ESMF_TimeInterval -! NetCDF datetime is: {integer, character(len=*)} -! {1800, 'seconds since 2010-01-23 18:30:37'} -! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} -module MAPL_NetCDF - - use MAPL_ExceptionHandling - use MAPL_KeywordEnforcerMod - use MAPL_DateTime_Parsing - use ESMF - - implicit none - - public :: convert_NetCDF_DateTime_to_ESMF - public :: convert_ESMF_to_NetCDF_DateTime - - private - public :: make_ESMF_TimeInterval - public :: make_NetCDF_DateTime_int_time - public :: make_NetCDF_DateTime_units_string - public :: convert_ESMF_Time_to_NetCDF_DateTimeString - public :: convert_to_integer - public :: convert_NetCDF_DateTimeString_to_ESMF_Time - public :: is_time_unit - public :: is_valid_netcdf_datetime_string - public :: get_shift_sign - public :: split - public :: split_all - public :: lr_trim - - character, parameter :: PART_DELIM = ' ' - character, parameter :: ISO_DELIM = 'T' - character, parameter :: DATE_DELIM = '-' - character, parameter :: TIME_DELIM = ':' - character(len=*), parameter :: NETCDF_DATE = '0000' // DATE_DELIM // '00' // DATE_DELIM // '00' - character(len=*), parameter :: NETCDF_TIME = '00' // TIME_DELIM // '00' // TIME_DELIM // '00' - character(len=*), parameter :: NETCDF_DATETIME_FORMAT = NETCDF_DATE // PART_DELIM // NETCDF_TIME - integer, parameter :: LEN_DATE = len(NETCDF_DATE) - integer, parameter :: LEN_TIME = len(NETCDF_TIME) - integer, parameter :: LEN_NETCDF_DATETIME = len(NETCDF_DATETIME_FORMAT) - character(len=*), parameter :: TIME_UNITS(7) = & - [ 'years ', 'months ', 'days ', & - 'hours ', 'minutes ', 'seconds ', 'milliseconds' ] - character, parameter :: SPACE = ' ' - type(ESMF_CalKind_Flag), parameter :: CALKIND_FLAG = ESMF_CALKIND_GREGORIAN - integer, parameter :: MAX_WIDTH = 10 - integer, parameter :: NUM_PARTS_UNITS_STRING = 4 - -contains - - ! Convert NetCDF_DateTime {int_time, units_string} to - ! ESMF time variables {interval, time0, time1} and time unit {tunit} - ! time0 is the start time, and time1 is time0 + interval - subroutine convert_NetCDF_DateTime_to_ESMF(int_time, units_string, & - interval, time0, unusable, time1, tunit, rc) - integer, intent(in) :: int_time - character(len=*), intent(in) :: units_string - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: time0 - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: time1 - character(len=:), allocatable, optional, intent(out) :: tunit - integer, optional, intent(out) :: rc - character(len=:), allocatable :: tunit_ - character(len=len_trim(units_string)) :: parts(2) - character(len=len_trim(units_string)) :: head - character(len=len_trim(units_string)) :: tail - - integer :: span, factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(int_time >= 0, 'Negative span not supported') - _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') - - ! get time unit, tunit - parts = split(lr_trim(units_string), PART_DELIM) - head = parts(1) - tail = parts(2) - tunit_ = lr_trim(head) - _ASSERT(is_time_unit(tunit_), 'Unrecognized time unit') - if(present(tunit)) tunit = tunit_ - - ! get span - parts = split(lr_trim(tail), PART_DELIM) - head = parts(1) - tail = parts(2) - - factor = get_shift_sign(head) - _ASSERT(factor /= 0, 'Unrecognized preposition') - span = factor * int_time - - call convert_NetCDF_DateTimeString_to_ESMF_Time(lr_trim(tail), time0, _RC) - call make_ESMF_TimeInterval(span, tunit_, time0, interval, _RC) - - ! get time1 - if(present(time1)) time1 = time0 + interval - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTime_to_ESMF - - ! Convert ESMF time variables to an NetCDF datetime - subroutine convert_ESMF_to_NetCDF_DateTime(tunit, t0, int_time, units_string, unusable, t1, interval, rc) - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 - integer, intent(out) :: int_time - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Time), optional, intent(inout) :: t1 - type(ESMF_TimeInterval), optional, intent(inout) :: interval - integer, optional, intent(out) :: rc - type(ESMF_TimeInterval) :: interval_ - integer :: status - - _UNUSED_DUMMY(unusable) - - if(present(interval)) then - interval_ = interval - elseif(present(t1)) then - interval_ = t1 - t0 - else - _FAIL( 'Only one input argument present') - end if - - call make_NetCDF_DateTime_int_time(interval_, t0, tunit, int_time, _RC) - call make_NetCDF_DateTime_units_string(t0, tunit, units_string, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_to_NetCDF_DateTime - - ! Make ESMF_TimeInterval from a span of time, time unit, and start time - subroutine make_ESMF_TimeInterval(span, tunit, t0, interval, unusable, rc) - integer, intent(in) :: span - character(len=*), intent(in) :: tunit - type(ESMF_Time), intent(inout) :: t0 - type(ESMF_TimeInterval), intent(inout) :: interval - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - select case(lr_trim(tunit)) - case('years') - call ESMF_TimeIntervalSet(interval, startTime=t0, yy=span, _RC) - case('months') - call ESMF_TimeIntervalSet(interval, startTime=t0, mm=span, _RC) - case('hours') - call ESMF_TimeIntervalSet(interval, startTime=t0, h=span, _RC) - case('minutes') - call ESMF_TimeIntervalSet(interval, startTime=t0, m=span, _RC) - case('seconds') - call ESMF_TimeIntervalSet(interval, startTime=t0, s=span, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_ESMF_TimeInterval - - ! Get time span from NetCDF datetime - subroutine make_NetCDF_DateTime_int_time(interval, t0, tunit, int_time, unusable, rc) - type(ESMF_TimeInterval), intent(inout) :: interval - type(ESMF_Time), intent(inout) :: t0 - character(len=*), intent(in) :: tunit - integer, intent(out) :: int_time - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - - _UNUSED_DUMMY(unusable) - - ! get int_time - select case(lr_trim(tunit)) - case('years') - call ESMF_TimeIntervalGet(interval, t0, yy=int_time, _RC) - case('months') - call ESMF_TimeIntervalGet(interval, t0, mm=int_time, _RC) - case('hours') - call ESMF_TimeIntervalGet(interval, t0, h=int_time, _RC) - case('minutes') - call ESMF_TimeIntervalGet(interval, t0, m=int_time, _RC) - case('seconds') - call ESMF_TimeIntervalGet(interval, t0, s=int_time, _RC) - case default - _FAIL('Unrecognized unit') - end select - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_int_time - - ! Make 'units' for NetCDF datetime - subroutine make_NetCDF_DateTime_units_string(t0, tunit, units_string, unusable, rc) - type(ESMF_Time), intent(inout) :: t0 - character(len=*), intent(in) :: tunit - character(len=:), allocatable, intent(out) :: units_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - character(len=*), parameter :: preposition = 'since' - character(len=:), allocatable :: datetime_string - integer :: status - - _UNUSED_DUMMY(unusable) - - ! make units_string - call convert_ESMF_Time_to_NetCDF_DateTimeString(t0, datetime_string, _RC) - units_string = tunit //SPACE// preposition //SPACE// datetime_string - - _RETURN(_SUCCESS) - - end subroutine make_NetCDF_DateTime_units_string - - ! Convert ESMF_Time to a NetCDF datetime string (start datetime) - subroutine convert_ESMF_Time_to_NetCDF_DateTimeString(esmf_datetime, datetime_string, unusable, rc) - type(ESMF_Time), intent(inout) :: esmf_datetime - character(len=:), allocatable, intent(out) :: datetime_string - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - character(len=*), parameter :: ERR_PRE = 'Failed to write string: ' - integer :: yy, mm, dd, h, m, s - character(len=10) :: FMT - character(len=4) :: yy_string - character(len=2) :: mm_string - character(len=2) :: dd_string - character(len=2) :: h_string - character(len=2) :: m_string - character(len=2) :: s_string - character(len=LEN_NETCDF_DATETIME) :: tmp_string - integer :: status, iostatus - - _UNUSED_DUMMY(unusable) - - call ESMF_TimeGet(esmf_datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - FMT='(BZ, I2.2)' - write(s_string, fmt=FMT, iostat=iostatus) s - _ASSERT(iostatus == 0, ERR_PRE // 'second') - write(m_string, fmt=FMT, iostat=iostatus) m - _ASSERT(iostatus == 0, ERR_PRE // 'minute') - write(h_string, fmt=FMT, iostat=iostatus) h - _ASSERT(iostatus == 0, ERR_PRE // 'hour') - write(dd_string, fmt=FMT, iostat=iostatus) dd - _ASSERT(iostatus == 0, ERR_PRE // 'day') - write(mm_string, fmt=FMT, iostat=iostatus) mm - _ASSERT(iostatus == 0, ERR_PRE // 'month') - FMT='(BZ, I4.4)' - write(yy_string, fmt=FMT, iostat=iostatus) yy - _ASSERT(iostatus == 0, ERR_PRE // 'year') - - tmp_string = yy_string // DATE_DELIM // mm_string // DATE_DELIM // dd_string // PART_DELIM // & - h_string // TIME_DELIM // m_string // TIME_DELIM // s_string - - datetime_string = tmp_string - - _RETURN(_SUCCESS) - - end subroutine convert_ESMF_Time_to_NetCDF_DateTimeString - - ! Convert string representing an integer to the integer - subroutine convert_to_integer(string_in, int_out, rc) - character(len=*), intent(in) :: string_in - integer, intent(out) :: int_out - integer, optional, intent(out) :: rc - integer :: stat - - read(string_in, '(I16)', iostat=stat) int_out - - if(present(rc)) rc = stat - - end subroutine convert_to_integer - - ! Convert NetCDF datetime to ESMF_Time - subroutine convert_NetCDF_DateTimeString_to_ESMF_Time(datetime_string, datetime, unusable, rc) - character(len=*), intent(in) :: datetime_string - type(ESMF_Time), intent(inout) :: datetime - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - integer :: status - integer :: yy, mm, dd, h, m, s, i, j - character(len=4) :: part - - _UNUSED_DUMMY(unusable) - - _ASSERT(is_valid_netcdf_datetime_string(datetime_string), 'Invalid datetime string') - - i = 1 - j = i + 3 - part = datetime_string(i:j) - call convert_to_integer(part, yy, rc = status) - _ASSERT(status == 0, 'Unable to convert year string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, mm, rc = status) - _ASSERT(status == 0, 'Unable to convert month string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, dd, rc = status) - _ASSERT(status == 0, 'Unable to convert day string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, h, rc = status) - _ASSERT(status == 0, 'Unable to convert hour string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, m, rc = status) - _ASSERT(status == 0, 'Unable to convert minute string') - - i = j + 2 - j = j + 3 - part = datetime_string(i:j) - call convert_to_integer(part, s, rc = status) - _ASSERT(status == 0, 'Unable to convert second string') - call ESMF_CalendarSetDefault(CALKIND_FLAG, _RC) - call ESMF_TimeSet(datetime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - - _RETURN(_SUCCESS) - - end subroutine convert_NetCDF_DateTimeString_to_ESMF_Time - - function is_valid_netcdf_datetime_string(string) result(tval) - character(len=*), parameter :: DIGITS = '0123456789' - character(len=*), intent(in) :: string - logical :: tval - integer :: i - - tval = .false. - - if(len(string) /= len(NETCDF_DATETIME_FORMAT)) return - - do i=1, len(string) - if(scan(NETCDF_DATETIME_FORMAT(i:i), DIGITS) > 0) then - if(scan(string(i:i), DIGITS) <= 0) return - else - if(string(i:i) /= NETCDF_DATETIME_FORMAT(i:i)) return - end if - end do - - tval = .true. - - end function is_valid_netcdf_datetime_string - - function is_time_unit(tunit) - character(len=*), intent(in) :: tunit - logical :: is_time_unit - integer :: i - - is_time_unit = .TRUE. - do i = 1, size(TIME_UNITS) - if(lr_trim(tunit) == lr_trim(TIME_UNITS(i))) return - end do - is_time_unit = .FALSE. - - end function is_time_unit - - function lr_trim(string) - character(len=*), intent(in) :: string - character(len=:), allocatable :: lr_trim - - lr_trim = trim(adjustl(string)) - - end function lr_trim - - ! Get the sign of integer represening a time span based on preposition - function get_shift_sign(preposition) - character(len=*), intent(in) :: preposition - integer :: get_shift_sign - integer, parameter :: POSITIVE = 1 - get_shift_sign = 0 - if(lr_trim(preposition) == 'since') get_shift_sign = POSITIVE - end function get_shift_sign - - ! Split string at delimiter - function split(string, delimiter) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=len(string)) :: split(2) - integer start - - split = ['', ''] - split(1) = string - start = index(string, delimiter) - if(start < 1) return - split(1) = string(1:(start - 1)) - split(2) = string((start+len(delimiter)):len(string)) - end function split - - ! Split string into all substrings based on delimiter - recursive function split_all(string, delimiter) result(parts) - character(len=*), intent(in) :: string - character(len=*), intent(in) :: delimiter - character(len=:), allocatable :: parts(:) - integer :: start - - start = index(string, delimiter) - - if(start == 0) then - parts = [string] - else - parts = [string(1:(start-1)), split_all(string((start+len(delimiter)):len(string)), delimiter)] - end if - - end function split_all - - subroutine convert_NetCDF_DateTime_to_ESMF_Time_integer(span, units_string, & - time, unusable, rc) - - integer, intent(in) :: span - character(len=*), intent(in) :: units_string - type(ESMF_Time), optional, intent(inout) :: time - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - type(ESMF_TimeInterval), :: interval - type(ESMF_Time) :: time0 - character(len=:), allocatable :: tunit - character(len=:), allocatable :: parts(:) - character(len=:), allocatable :: head - character(len=:), allocatable :: tail - integer :: span, factor - integer :: status - - _UNUSED_DUMMY(unusable) - - _ASSERT(span >= 0, 'Negative span not supported') - _ASSERT((len(lr_trim(units_string)) > 0), 'units empty') - - parts = split_all(units_string, PART_DELIM) -end module MAPL_NetCDF From 5bb0b98da1b234694ee9623500fa39f14d6478ac Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 16 Aug 2023 09:07:42 -0400 Subject: [PATCH 20/32] Add tests for MAPL_DateTime_Parsing and MAPL_DateTime_Parsing.pf --- base/tests/test_MAPL_DateTime_Parsing_ESMF.pf | 7 + base/tests/test_MAPL_NetCDF_helpers.F90 | 67 ---- base/tests/test_MAPL_NetCDF_private.pf | 357 ------------------ run_cmake | 3 - run_cmake.gfortran | 3 - run_cmake.ifort | 3 - shared/tests/test_MAPL_DateTime_Parsing.pf | 59 +++ 7 files changed, 66 insertions(+), 433 deletions(-) create mode 100644 base/tests/test_MAPL_DateTime_Parsing_ESMF.pf delete mode 100644 base/tests/test_MAPL_NetCDF_helpers.F90 delete mode 100644 base/tests/test_MAPL_NetCDF_private.pf delete mode 100755 run_cmake delete mode 100755 run_cmake.gfortran delete mode 100755 run_cmake.ifort diff --git a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf new file mode 100644 index 000000000000..256647e41e3f --- /dev/null +++ b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf @@ -0,0 +1,7 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +!=============================================================================== +! TEST_MAPL_DATETIMEPARSING_ESMF +!=============================================================================== +module test_MAPL_DateTimeParsing_ESMF +end module test_MAPL_DateTimeParsing_ESMF diff --git a/base/tests/test_MAPL_NetCDF_helpers.F90 b/base/tests/test_MAPL_NetCDF_helpers.F90 deleted file mode 100644 index 4a2ed06c185e..000000000000 --- a/base/tests/test_MAPL_NetCDF_helpers.F90 +++ /dev/null @@ -1,67 +0,0 @@ -module test_MAPL_NetCDF_helpers - - use ESMF - - implicit none - - integer, parameter :: SUCCESS = 0 - -contains -!=============================================================================== -! HELPERS -!=============================================================================== - function make_datetime_string(yy, mm, dd, h, m, s) result(datetime_string) - integer, intent(in) :: yy, mm, dd, h, m, s - character(len=32) :: datetime_string - character(len=*), parameter :: fmt_string = '(I4.4, "-", I2.2, "-", I2.2, 1X, I2.2, ":", I2.2, ":", I2.2)' - integer :: iostat_ - - write(datetime_string, fmt=fmt_string, iostat=iostat_) yy, mm, dd, h, m, s - if(iostat_ == SUCCESS) return - datetime_string = '' - - end function make_datetime_string - - function make_units_string(units, preposition, yy, mm, dd, h, m, s) result(units_string) - character(len=*), intent(in) :: units - character(len=*), intent(in) :: preposition - integer, intent(in) :: yy, mm, dd, h, m, s - character(len=132) :: units_string - character(len=:), allocatable :: datetime_string - character(len=*), parameter :: SPACE = ' ' - - units_string = '' - datetime_string = make_datetime_string(yy, mm, dd, h, m, s) - if(len_trim(datetime_string) == 0) return - units_string = trim(units) // SPACE // trim(preposition) // SPACE // datetime_string - - end function make_units_string - - logical function rational_equals(na, nb) - integer, intent(in) :: na(2) - integer, intent(in) :: nb(2) - - rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) - - end function rational_equals - - function ESMF_Times_Equal(timeu, timev) result(tval) - type(ESMF_Time), intent(in) :: timeu, timev - logical :: tval - integer :: uyy, umm, udd, uh, um, us, usN, usD - integer :: vyy, vmm, vdd, vh, vm, vs, vsN, vsD - integer :: status - - tval = .FALSE. - call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) - if(status /= SUCCESS) return - call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) - if(status /= SUCCESS) return - - tval = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & - .and. (uh == vh) .and. (um == vm) .and. (us == vs) & - .and. rational_equals([usN, usD], [vsN, vsD]) ) - - end function ESMF_Times_Equal - -end module test_MAPL_NetCDF_helpers diff --git a/base/tests/test_MAPL_NetCDF_private.pf b/base/tests/test_MAPL_NetCDF_private.pf deleted file mode 100644 index 97549e46f3e4..000000000000 --- a/base/tests/test_MAPL_NetCDF_private.pf +++ /dev/null @@ -1,357 +0,0 @@ -#include "MAPL_Exceptions.h" -#include "MAPL_ErrLog.h" -! These tests should only run when you are debugging. -!=============================================================================== -! TEST_MAPL_NETCDF_PRIVATE -!=============================================================================== -module test_MAPL_NetCDF_private - - use MAPL_NetCDF - use test_MAPL_NetCDF_helpers - use MAPL_ExceptionHandling - use ESMF - use pfunit - - implicit none - -contains - - @Test - subroutine test_make_ESMF_TimeInterval_integer() - character(len=*), parameter :: units = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - integer, parameter :: duration = 1800 - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - integer :: rc, status - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s=duration, _RC) - call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) - @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') - - end subroutine test_make_ESMF_TimeInterval_integer - - @Test - subroutine test_make_NetCDF_DateTime_duration_integer() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - integer, parameter :: expected_duration = 1800 - integer :: duration - integer :: status, rc - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s=expected_duration, _RC) - - call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) - @assertEqual(expected_duration, duration, 'duration does not match.') - - end subroutine test_make_NetCDF_DateTime_duration_integer - - @Test - subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time() - character(len=19), parameter:: netcdf_string='2023-01-31 14:04:37' - type(ESMF_Time) :: etime - integer :: yy, mm, dd, h, m, s - integer :: status, rc - - call convert_NetCDF_DateTimeString_to_ESMF_Time(netcdf_string, etime, _RC) - call ESMF_TimeGet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, _RC) - @assertEqual(2023, yy, 'Incorrect year') - @assertEqual(01, mm, 'Incorrect month') - @assertEqual(31, dd, 'Incorrect day') - @assertEqual(14, h, 'Incorrect hour') - @assertEqual(04, m, 'Incorrect minute') - @assertEqual(37, s, 'Incorrect second') - - end subroutine test_convert_NetCDF_DateTimeString_to_ESMF_Time - - @Test - subroutine test_get_shift_sign() - character(len=:), allocatable :: preposition - integer, parameter :: expected = 1 - - preposition = 'since' - @assertEqual(expected, get_shift_sign(preposition)) - preposition = 'before' - @assertFalse(get_shift_sign(preposition) == expected) - preposition = '' - @assertFalse(get_shift_sign(preposition) == expected) - end subroutine test_get_shift_sign - - @Test - subroutine test_split_characters() - integer, parameter :: N = 64 - character(len=*), parameter :: PART1 = 'duck' - character(len=*), parameter :: PART2 = 'deer' - character(len=*), parameter :: YEAR = '1984' - character(len=*), parameter :: MONTH = '11' - character(len=*), parameter :: DAY = '30' - character(len=*), parameter :: HOUR = '19' - character(len=*), parameter :: MINUTE = '19' - character(len=*), parameter :: SECOND = '19.327' - character, parameter :: D = '-' - character, parameter :: T = ':' - character, parameter :: S = ' ' - - character(len=N) :: test_string - character(len=N) :: remainder - character(len=N) :: token - character(len=:), allocatable :: delimiters - - delimiters = S - test_string = trim(PART1) // delimiters // trim(PART2) - call split(trim(test_string), token, remainder) - @assertEqual(PART1, token, "First part doesn't match.") - @assertEqual(PART2, remainder, "Second part doesn't match.") - - delimiters = '- :' - test_string = YEAR // D // MONTH // D // DAY // S // HOUR // T // MINUTE // T // SECOND - call split(trim(test_string), token, remainder, trim(delimiters)) - @assertEqual(YEAR, token, "YEAR doesn't match.") - call split(trim(remainder), token, remainder, trim(delimiters)) - @assertEqual(MONTH, token, "MONTH doesn't match.") - call split(trim(remainder), token, remainder, trim(delimiters)) - @assertEqual(DAY, token, "DAY doesn't match.") - call split(trim(remainder), token, remainder, trim(delimiters)) - @assertEqual(HOUR, token, "HOUR doesn't match.") - call split(trim(remainder), token, remainder, trim(delimiters)) - @assertEqual(MINUTE, token, "MINUTE doesn't match.") - call split(trim(remainder), token, remainder, trim(delimiters)) - @assertEqual(SECOND, token, "SECOND doesn't match.") - - end subroutine test_split_characters - - @Test - subroutine test_is_valid_netcdf_datetime_string() - character(len=:), allocatable :: string - - string = '1970-01-01 23:59:59' - @assertTrue(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970:01-01 23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01 23-59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - string = '1970-01-01T23:59:59' - @assertFalse(is_valid_netcdf_datetime_string(string), string // ' is not a valid NetCDF datetime string.') - - end subroutine test_is_valid_netcdf_datetime_string - - @Test - subroutine test_convert_to_integer() - character(len=:), allocatable :: str - integer :: expected, actual, status - - expected = 2023 - str = '2023' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = -2023 - str = '-2023' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = 0 - str = '0' - call convert_to_integer(str, actual, rc = status) - @assertTrue(status == SUCCESS, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, 'Incorrect conversion: ' // str) - - expected = 0 - str = '0.0' - call convert_to_integer(str, actual, rc = status) - @assertTrue(.not. status == SUCCESS, str // ' should not convert.') - - end subroutine test_convert_to_integer - - @Test - subroutine test_make_ESMF_TimeInterval_real() - character(len=*), parameter :: units = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - real(kind=ESMF_KIND_R8), parameter :: duration = 1800 - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: start_time - type(ESMF_TimeInterval) :: interval - integer :: rc, status - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(expected_interval, startTime=start_time, s_r8=duration, _RC) - call make_ESMF_TimeInterval(duration, units, start_time, interval, _RC) - @assertTrue(expected_interval == interval, 'ESMF_TimeInterval variables do not match.') - - end subroutine test_make_ESMF_TimeInterval_real - - @Test - subroutine test_make_NetCDF_DateTime_duration_real() - character(len=*), parameter :: tunit = 'seconds' - character(len=*), parameter :: iso_string = '2013-08-26T12:34:56' - type(ESMF_TimeInterval) :: interval - type(ESMF_Time) :: start_time - real(kind=ESMF_KIND_R8), parameter :: expected_duration = 1800 - real(kind=ESMF_KIND_R8) :: duration - integer :: status, rc - - call ESMF_TimeSet(start_time, iso_string, _RC) - call ESMF_TimeIntervalSet(interval, startTime=start_time, s_r8=expected_duration, _RC) - - call make_NetCDF_DateTime_duration(interval, start_time, tunit, duration, _RC) - @assertEqual(expected_duration, duration, 'int_time does not match.') - - end subroutine test_make_NetCDF_DateTime_duration_real - - @Test - subroutine test_is_digit_string() - character(len=:), allocatable :: test_string - - test_string = '1' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = '9362754810' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = '125 ' - @assertTrue(is_digit_string(test_string), '"' // test_string // '" is a digit string.') - test_string = 'ADFG' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '1ADFG' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '1213A' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = ' 1213' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = ' ' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '%^*' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '9%^*7' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - test_string = '' - @assertTrue(.not. is_digit_string(test_string), '"' // test_string // '" is not a digit string.') - end subroutine test_is_digit_string - - @Test - subroutine test_convert_to_real() - character(len=:), allocatable :: str - real(kind=ESMF_KIND_R8) :: expected, actual - real(kind=ESMF_KIND_R8), parameter :: RELATIVE_TOLERANCE = 1D-08 - real(kind=ESMF_KIND_R8) :: tolerance - integer :: status - - expected = 6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '6.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = -6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '-6.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 2023 - tolerance = expected * RELATIVE_TOLERANCE - str = '2023' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 0.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '0.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 0.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = '.015625' - call convert_to_real(str, actual, rc = status) - @assertEqual(SUCCESS, status, 'Unsuccessful conversion: ' // str) - @assertEqual(expected, actual, tolerance, 'Incorrect conversion: ' // str) - - expected = 6.015625 - tolerance = expected * RELATIVE_TOLERANCE - str = 'asdf6.015625' - call convert_to_real(str, actual, rc = status) - @assertTrue(.not. status == SUCCESS, str // ' should not convert.') - - end subroutine test_convert_to_real - - @Test - subroutine test_ESMF_Times_Equal() - integer :: yy = 1957 - integer :: mm = 10 - integer :: dd = 19 - integer :: h = 18 - integer :: m = 37 - integer :: s = 53 - type(ESMF_Time) :: timea, timeb - integer :: status - - call ESMF_TimeSet(timea, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create timea') - call ESMF_TimeSet(timeb, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc = status) - @assertTrue(status == SUCCESS, 'Failed to create timeb') - @assertTrue(timea == timeb, 'ESMF_Time values are not equal.') - @assertTrue(ESMF_Times_Equal(timea, timeb), 'ESMF_Time values do not match.') - - end subroutine test_ESMF_Times_Equal - - @Test - subroutine test_make_datetime_string() - integer, parameter :: YY = 1999 - integer, parameter :: MM = 12 - integer, parameter :: DD = 31 - integer, parameter :: H = 23 - integer, parameter :: M = 59 - integer, parameter :: S = 59 - - character(len=*), parameter :: EXPECTED_DATETIME_STRING = '1999-12-31 23:59:59' - integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_DATETIME_STRING) - - character(len=:), allocatable :: actual_datetime_string - - actual_datetime_string = make_datetime_string(yy, mm, dd, h, m, s) - @assertEqual(EXPECTED_LENGTH, len_trim(actual_datetime_string), 'Incorrect length for datetime string') - @assertEqual(EXPECTED_DATETIME_STRING, trim(actual_datetime_string), 'Datetime strings do not match.') - - end subroutine test_make_datetime_string - - @Test - subroutine test_make_units_string() - integer, parameter :: YY = 1999 - integer, parameter :: MM = 12 - integer, parameter :: DD = 31 - integer, parameter :: H = 23 - integer, parameter :: M = 59 - integer, parameter :: S = 59 - - character(len=*), parameter :: SPACE = ' ' - character(len=*), parameter :: EXPECTED_UNITS = 'seconds' - character(len=*), parameter :: EXPECTED_PREPOSITION = 'since' - character(len=*), parameter :: EXPECTED_UNITS_STRING = EXPECTED_UNITS // & - SPACE // EXPECTED_PREPOSITION // SPACE // '1999-12-31 23:59:59' - integer, parameter :: EXPECTED_LENGTH = len(EXPECTED_UNITS_STRING) - - character(len=:), allocatable :: actual_units_string - - actual_units_string = make_units_string(EXPECTED_UNITS, EXPECTED_PREPOSITION, YY, MM, DD, H, M, S) - @assertEqual(EXPECTED_LENGTH, len_trim(actual_units_string), "Incorrect length for actual_units_string") - @assertEqual(EXPECTED_UNITS_STRING, actual_units_string, "Units_string's do not match.") - - end subroutine test_make_units_string - -end module test_MAPL_NetCDF_private diff --git a/run_cmake b/run_cmake deleted file mode 100755 index 6d83cef21e04..000000000000 --- a/run_cmake +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env bash - -cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_INSTALL_PREFIX=../install -DCMAKE_BUILD_TYPE=Debug diff --git a/run_cmake.gfortran b/run_cmake.gfortran deleted file mode 100755 index f4bcb4d34bd3..000000000000 --- a/run_cmake.gfortran +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env bash - -cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_INSTALL_PREFIX=../install diff --git a/run_cmake.ifort b/run_cmake.ifort deleted file mode 100755 index 0a546a67bfe7..000000000000 --- a/run_cmake.ifort +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env bash - -cmake .. -DBASEDIR=${BASEDIR}/Linux -DCMAKE_Fortran_COMPILER=ifort -DCMAKE_INSTALL_PREFIX=../install diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index 6491b0d9d267..c05f98131b3a 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -627,6 +627,65 @@ contains @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.') end subroutine test_construct_datetime_duration + subroutine test_set_year_datetime_duration() + end subroutine test_set_year_datetime_duration + + subroutine test_set_month_datetime_duration() + end subroutine test_set_month_datetime_duration + + subroutine test_set_day_datetime_duration() + end subroutine test_set_day_datetime_duration + + subroutine test_set_hour_datetime_duration() + end subroutine test_set_hour_datetime_duration + + subroutine test_set_minute_datetime_duration() + end subroutine test_set_minute_datetime_duration + + subroutine test_set_second_datetime_duration() + end subroutine test_set_second_datetime_duration + + subroutine test_set_hour_real_datetime_duration() + end subroutine test_set_hour_real_datetime_duration + + subroutine test_set_minute_real_datetime_duration() + end subroutine test_set_minute_real_datetime_duration + + subroutine test_set_second_real_datetime_duration() + end subroutine test_set_second_real_datetime_duration + + subroutine test_set_real_value_datetime_duration() + end subroutine test_set_real_value_datetime_duration + + subroutine test_set_integer_value_datetime_duration() + end subroutine test_set_integer_value_datetime_duration + + subroutine test_is_valid_datestring() + end subroutine test_is_valid_datestring + + subroutine test_is_in_char_set() + end subroutine test_is_in_char_set + + subroutine test_find_delta_datestring() + end subroutine test_find_delta_datestring + + subroutine test_split_digit_string_delimited() + end subroutine test_split_digit_string_delimited + + subroutine test_valid_index() + end subroutine test_valid_index + + subroutine test_split_digit_string_indexed() + end subroutine test_split_digit_string_indexed + + subroutine test_convert_lengths_to_indices() + end subroutine test_convert_lengths_to_indices + + subroutine test_test_get_time_unit() + end subroutine test_test_get_time_unit + + subroutine test_test_is_time_unit + end subroutine test_test_is_time_unit ! @test ! subroutine test_time_unit() ! integer(kind(TIME_UNIT)) :: tu From f30637e21130f9640455bd35e02c69478b508b03 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 19 Sep 2023 10:59:36 -0400 Subject: [PATCH 21/32] Update for completion --- base/MAPL_DateTime_Parsing_ESMF.F90 | 50 ++-- base/MAPL_NetCDF.F90 | 45 ++-- base/tests/CMakeLists.txt | 1 + base/tests/test_MAPL_DateTime_Parsing_ESMF.pf | 67 +++++- base/tests/test_MAPL_NetCDF.pf | 31 ++- shared/MAPL_CF_Time.F90 | 150 ++++++------ shared/MAPL_DateTime_Parsing.F90 | 90 +++++-- shared/tests/CMakeLists.txt | 1 + shared/tests/test_MAPL_CF_Time.pf | 128 ++++++++++ shared/tests/test_MAPL_DateTime_Parsing.pf | 224 ++++++++++++++++-- 10 files changed, 616 insertions(+), 171 deletions(-) create mode 100644 shared/tests/test_MAPL_CF_Time.pf diff --git a/base/MAPL_DateTime_Parsing_ESMF.F90 b/base/MAPL_DateTime_Parsing_ESMF.F90 index 1a09876ad3df..76834995de86 100644 --- a/base/MAPL_DateTime_Parsing_ESMF.F90 +++ b/base/MAPL_DateTime_Parsing_ESMF.F90 @@ -1,9 +1,19 @@ -module MAPL_DateTimeParsing_ESMF - - use MAPL_DateTimeParsing +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_DateTime_Parsing_ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_DateTime_Parsing + use ESMF implicit none + public :: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 + + interface set_ESMF_TimeInterval + module procedure :: set_ESMF_TimeInterval_from_datetime_duration + end interface set_ESMF_TimeInterval + contains subroutine set_ESMF_TimeInterval_from_datetime_duration(interval, duration, rc) @@ -15,26 +25,26 @@ subroutine set_ESMF_TimeInterval_from_datetime_duration(interval, duration, rc) ! Get duration(s) from datetime_duration ! Set ESMF_TimeInterval - if(this % year_is_set) call ESMF_TimeIntervalSet(interval, yy = this % year, _RC) - if(this % month_is_set) call ESMF_TimeIntervalSet(interval, yy = this % month, _RC) - if(this % day_is_set) call ESMF_TimeIntervalSet(interval, yy = this % day, _RC) - - if(this % hour_is_real) then - call ESMF_TimeIntervalSet(interval, h_r8 = this % hour_real, _RC) - else if(this % hour_is_set) then - call ESMF_TimeIntervalSet(interval, h = this % hour, _RC) + if(duration % year_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % year, _RC) + if(duration % month_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % month, _RC) + if(duration % day_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % day, _RC) + + if(duration % hour_is_real) then + call ESMF_TimeIntervalSet(interval, h_r8 = duration % hour_real, _RC) + else if(duration % hour_is_set) then + call ESMF_TimeIntervalSet(interval, h = duration % hour, _RC) end if - if(this % minute_is_real) then - call ESMF_TimeIntervalSet(interval, m_r8 = this % minute_real, _RC) - else if(this % minute_is_set) then - call ESMF_TimeIntervalSet(interval, m = this % minute, _RC) + if(duration % minute_is_real) then + call ESMF_TimeIntervalSet(interval, m_r8 = duration % minute_real, _RC) + else if(duration % minute_is_set) then + call ESMF_TimeIntervalSet(interval, m = duration % minute, _RC) end if - if(this % second_is_real) then - call ESMF_TimeIntervalSet(interval, s_r8 = this % second_real, _RC) - else if(this % second_is_set) then - call ESMF_TimeIntervalSet(interval, s = this % second, _RC) + if(duration % second_is_real) then + call ESMF_TimeIntervalSet(interval, s_r8 = duration % second_real, _RC) + else if(duration % second_is_set) then + call ESMF_TimeIntervalSet(interval, s = duration % second, _RC) end if _RETURN(_SUCCESS) @@ -53,4 +63,4 @@ subroutine set_ESMF_Time_from_ISO8601(time, isostring, rc) end subroutine set_ESMF_Time_from_ISO8601 -end module MAPL_DateTimeParsing_ESMF +end module MAPL_DateTime_Parsing_ESMF diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 5a89ad2893e8..ce802c9857ea 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -10,22 +10,31 @@ module MAPL_NetCDF use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod use MAPL_DateTime_Parsing, only: datetime_duration - use MAPL_DateTime_Parsing_ESMF, only: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 - use MAPL_CF_Time, only: CF_Time, convert_CF_Time_to_datetime_duration, & - extract_ISO8601_from_CF_Time, extract_CF_Time_unit - use ESMF, only: ESMF_Time, ESMF_Time +! use MAPL_DateTime_Parsing_ESMF, only: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 + use MAPL_DateTime_Parsing_ESMF +! use MAPL_CF_Time, only: CF_Time, convert_CF_Time_to_datetime_duration, & +! extract_ISO8601_from_CF_Time, extract_CF_Time_unit + use MAPL_CF_Time +! use ESMF, only: ESMF_Time, ESMF_Time + use ESMF implicit none public :: convert_NetCDF_DateTime_to_ESMF + public :: get_ESMF_Time_from_NetCDF_DateTime private interface convert_NetCDF_DateTime_to_ESMF - module procedure :: convert_NetCDF_DateTime_to_ESMF_integer - module procedure :: convert_NetCDF_DateTime_to_ESMF_real + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real end interface convert_NetCDF_DateTime_to_ESMF + interface get_ESMF_Time_from_NetCDF_DateTime + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_integer + module procedure :: get_ESMF_Time_from_NetCDF_DateTime_real + end interface get_ESMF_Time_from_NetCDF_DateTime + integer, parameter :: MAX_CHARACTER_LENGTH = 64 contains @@ -36,7 +45,7 @@ module MAPL_NetCDF ! Convert NetCDF_DateTime {int_time, units_string} to ! ESMF time variables {interval, time0, time1} and time unit {tunit} ! time0 is the start time, and time1 is time0 + interval - subroutine convert_NetCDF_DateTime_to_ESMF_integer(duration, units_string, & + subroutine get_ESMF_Time_from_NetCDF_DateTime_integer(duration, units_string, & interval, time0, unusable, time1, tunit, rc) integer, intent(in) :: duration character(len=*), intent(in) :: units_string @@ -47,8 +56,8 @@ subroutine convert_NetCDF_DateTime_to_ESMF_integer(duration, units_string, & character(len=:), allocatable, optional, intent(out) :: tunit integer, optional, intent(out) :: rc - class(CF_Time) :: cft - class(datetime_duration) :: dt_duration + type(CF_Time_Integer) :: cft + type(datetime_duration) :: dt_duration character(len=MAX_CHARACTER_LENGTH) :: isostring character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status @@ -58,9 +67,9 @@ subroutine convert_NetCDF_DateTime_to_ESMF_integer(duration, units_string, & _ASSERT(duration >= 0, 'Negative span not supported') _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - cft = CF_Time(duration, units_string) + cft = CF_Time_Integer(duration, units_string) call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) - call set_ESMF_TimeInterval(interval, cft, _RC) + call set_ESMF_TimeInterval(interval, dt_duration, _RC) call extract_ISO8601_from_CF_Time(cft, isostring, _RC) call set_ESMF_Time_from_ISO8601(time0, isostring, _RC) @@ -74,12 +83,12 @@ subroutine convert_NetCDF_DateTime_to_ESMF_integer(duration, units_string, & _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTime_to_ESMF_integer + end subroutine get_ESMF_Time_from_NetCDF_DateTime_integer ! Convert NetCDF_DateTime {real_time, units_string} to ! ESMF time variables {interval, time0, time1} and time unit {tunit} ! time0 is the start time, and time1 is time0 + interval - subroutine convert_NetCDF_DateTime_to_ESMF_real(duration, units_string, & + subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, units_string, & interval, time0, unusable, time1, tunit, rc) real(kind=R64), intent(in) :: duration character(len=*), intent(in) :: units_string @@ -90,8 +99,8 @@ subroutine convert_NetCDF_DateTime_to_ESMF_real(duration, units_string, & character(len=:), allocatable, optional, intent(out) :: tunit integer, optional, intent(out) :: rc - class(CF_Time) :: cft - class(datetime_duration) :: dt_duration + type(CF_Time_Real) :: cft + type(datetime_duration) :: dt_duration character(len=MAX_CHARACTER_LENGTH) :: isostring character(len=MAX_CHARACTER_LENGTH) :: tunit_ integer :: status @@ -101,9 +110,9 @@ subroutine convert_NetCDF_DateTime_to_ESMF_real(duration, units_string, & _ASSERT(duration >= 0, 'Negative span not supported') _ASSERT((len_trim(adjustl(units_string)) > 0), 'units empty') - cft = CF_Time(duration, units_string) + cft = CF_Time_Real(duration, units_string) call convert_CF_Time_to_datetime_duration(cft, dt_duration, _RC) - call set_ESMF_TimeInterval(interval, cft, _RC) + call set_ESMF_TimeInterval(interval, dt_duration, _RC) call extract_ISO8601_from_CF_Time(cft, isostring, _RC) call set_ESMF_Time_from_ISO8601(time0, isostring, _RC) @@ -117,7 +126,7 @@ subroutine convert_NetCDF_DateTime_to_ESMF_real(duration, units_string, & _RETURN(_SUCCESS) - end subroutine convert_NetCDF_DateTime_to_ESMF_real + end subroutine get_ESMF_Time_from_NetCDF_DateTime_real !======================= END HIGH-LEVEL PROCEDURES ========================= !=============================================================================== diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 5d7469ce6716..f7477e029d1e 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -16,6 +16,7 @@ set (TEST_SRCS test_TimeStringConversion.pf test_MAPL_NetCDF.pf # test_MAPL_ISO8601_DateTime_ESMF.pf +# test_MAPL_DateTime_Parsing_ESMF.pf ) # SRCS are mostly mocks to facilitate tests diff --git a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf index 256647e41e3f..73dd0bc49704 100644 --- a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf +++ b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf @@ -1,7 +1,68 @@ #include "MAPL_Exceptions.h" -#include "MAPL_ErrLog.h" !=============================================================================== ! TEST_MAPL_DATETIMEPARSING_ESMF !=============================================================================== -module test_MAPL_DateTimeParsing_ESMF -end module test_MAPL_DateTimeParsing_ESMF +module test_MAPL_DateTime_Parsing_ESMF + use MAPL_DateTime_Parsing + use MAPL_DateTime_Parsing_ESMF + use MAPL_CF_Time + use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 + + implicit none + + integer, parameter :: SUCCESS = _SUCCESS !wdb deleteme + +contains + + @test + subroutine test_set_ESMF_TimeInterval_integer() + integer :: duration = 1800, actual + type(datetime_duration) :: dt_dur + character(len=*), parameter :: units = 'seconds since 1999-12-31 23:29:59' + type(ESMF_TimeInterval) :: interval + integer :: status + + call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) + @assertEqual(SUCCESS, status, 'Conversion unsuccessful') +! call set_ESMF_TimeInterval(interval, dt_dur, status) +! @assertEqual(SUCCESS, status, 'Set unsuccessful') +! call ESMF_TimeIntervalGet(interval, s = actual, rc = status) +! @assertEqual(SUCCESS, status, 'Get unsuccessful') +! @assertEqual(duration, actual, 'Incorrect interval duration') + + end subroutine test_set_ESMF_TimeInterval_integer + + @test + subroutine test_set_ESMF_TimeInterval_real() + real(R64) :: duration = 1800.0, actual + type(datetime_duration) :: dt_dur + character(len=*), parameter :: units = 'seconds since 1999-12-31 23:29:59' + type(ESMF_TimeInterval) :: interval + integer :: status + + call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) + @assertEqual(SUCCESS, status, 'Conversion unsuccessful') +! call set_ESMF_TimeInterval(interval, dt_dur, rc = status) +! @assertEqual(SUCCESS, status, 'Set unsuccessful') +! call ESMF_TimeIntervalGet(interval, s_r8 = actual, rc = status) +! @assertEqual(SUCCESS, status, 'Get unsuccessful') +! @assertEqual(duration, actual, 'Incorrect interval duration') + + end subroutine test_set_ESMF_TimeInterval_real + + @test + subroutine test_ESMF_Time_from_ISO8601() + character(len=*), parameter :: isostring = '1999-12-31T23:29:59' + character(len=len(isostring)) :: actual + type(ESMF_Time) :: time + integer :: status + + call set_ESMF_Time_from_ISO8601(time, isostring, rc = status) + @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') + call ESMF_TimeGet(time, timeStringISOFrac = actual, rc = status) + @assertTrue(status == SUCCESS, 'Failed to get isostring') + @assertEqual(isostring, actual, 'ISO8601 strings do not match.') + + end subroutine test_ESMF_Time_from_ISO8601 + +end module test_MAPL_DateTime_Parsing_ESMF diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 93d034b1e435..4fd47350fe50 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -5,7 +5,6 @@ !=============================================================================== module test_MAPL_NetCDF - use test_MAPL_NetCDF_helpers use MAPL_ExceptionHandling use MAPL_NetCDF use ESMF @@ -23,10 +22,18 @@ contains integer :: status call ESMF_CalendarSetDefault(CALKIND_FLAG_DEF, rc=status) - if(status /= SUCCESS) write(*, *) 'Failed to set ESMF_Calendar' + if(status /= _SUCCESS) write(*, *) 'Failed to set ESMF_Calendar' end subroutine set_up + logical function rational_equals(na, nb) + integer, intent(in) :: na(2) + integer, intent(in) :: nb(2) + + rational_equals = ( na(1) * nb(2) == na(2) * nb(1) ) + + end function rational_equals + function ESMF_Times_Equal(timeu, timev) result(tval) type(ESMF_Time), intent(in) :: timeu, timev logical :: tval @@ -36,9 +43,9 @@ contains tval = .FALSE. call ESMF_TimeGet(timeu, yy=uyy, mm=umm, dd=udd, h=uh, m=um, d=us, sN=usN, sD=usD, rc = status) - if(status /= SUCCESS) return + if(status /= _SUCCESS) return call ESMF_TimeGet(timev, yy=vyy, mm=vmm, dd=vdd, h=vh, m=vm, d=vs, sN=vsN, sD=vsD, rc = status) - if(status /= SUCCESS) return + if(status /= _SUCCESS) return tval = ( (uyy == vyy) .and. (umm == vmm) .and. (udd == vdd) & .and. (uh == vh) .and. (um == vm) .and. (us == vs) & @@ -51,7 +58,7 @@ contains integer :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=*), parameter :: UNITS = 'seconds' - character(len=:), allocatable :: tunit + character(len=:), allocatable :: tunit, units_string type(ESMF_Time) :: time, etime, btime type(ESMF_TimeInterval) :: time_interval integer :: status @@ -67,17 +74,17 @@ contains units_string = UNITS // ' since 1999-12-31 23:29:59' call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected base ESMF_Time') + @assertTrue(status == _SUCCESS, 'Unable to create expected base ESMF_Time') call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & time1 = time, tunit = tunit, rc = status) - @assertTrue(status == SUCCESS, 'Conversion failed') + @assertTrue(status == _SUCCESS, 'Conversion failed') @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_integer @@ -87,7 +94,7 @@ contains real(kind=ESMF_KIND_R8) :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=*), parameter :: UNITS = 'seconds' - character(len=:), allocatable :: tunit + character(len=:), allocatable :: tunit, units_string type(ESMF_Time) :: time, etime, btime type(ESMF_TimeInterval) :: time_interval integer :: status @@ -103,17 +110,17 @@ contains units_string = UNITS // ' since 1999-12-31 23:29:59' call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & time1 = time, tunit = tunit, rc = status) - @assertTrue(status == SUCCESS, 'Conversion failed') + @assertTrue(status == _SUCCESS, 'Conversion failed') @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertTrue(status == SUCCESS, 'Unable to create expected ESMF_Time') + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_real diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 index a7d0ce9d9949..a818b07bea42 100644 --- a/shared/MAPL_CF_Time.F90 +++ b/shared/MAPL_CF_Time.F90 @@ -19,7 +19,9 @@ module MAPL_CF_Time public :: convert_CF_Time_to_datetime_duration ! Convert ISO8601 datetime string to CF_Time_base_datetime public :: convert_ISO8601_to_CF_Time_base_datetime + public :: CF_Time, CF_Time_Integer, CF_Time_Real + public :: MAX_CHARACTER_LENGTH ! PUBLIC PROCEDURES (INTERFACES): @@ -27,7 +29,7 @@ module MAPL_CF_Time interface extract_ISO8601_from_CF_Time module procedure :: extract_ISO8601_from_CF_Time_units module procedure :: extract_ISO8601_from_CF_Time_cf_time - end interface + end interface extract_ISO8601_from_CF_Time ! Extract the duration of a CF Time. interface extract_CF_Time_duration @@ -64,8 +66,8 @@ module MAPL_CF_Time logical :: is_valid character(len=:), allocatable :: time_unit character(len=:), allocatable :: base_datetime - contains - procedure, public, pass(this) :: check => check_cf_time +! contains +! procedure, public, pass(this) :: check => check_cf_time end type CF_Time type, extends(CF_Time) :: CF_Time_Integer @@ -76,16 +78,18 @@ module MAPL_CF_Time real(kind=R64) :: duration end type CF_Time_Real - interface CF_Time + interface CF_Time_Integer module procedure :: construct_cf_time_integer + end interface CF_Time_Integer + + interface CF_Time_Real module procedure :: construct_cf_time_real - end interface CF_Time + end interface CF_Time_Real ! END CF_TIME ! CONSTANTS: - integer, parameter :: MAX_CHARACTER_LENGTH = 64 character, parameter :: DATE_DELIM = '-' character, parameter :: TIME_DELIM = ':' character, parameter :: ISO_DELIM = 'T' @@ -106,7 +110,7 @@ subroutine extract_ISO8601_from_CF_Time_units(units, isostring, rc) type(CF_Time_Integer) :: cft integer :: status - call extract_ISO8601_from_CF_Time(CF_Time(0, units), isostring, _RC) + call extract_ISO8601_from_CF_Time(CF_Time_Integer(0, units), isostring, _RC) _RETURN(_SUCCESS) @@ -118,12 +122,13 @@ subroutine extract_ISO8601_from_CF_Time_cf_time(cft, isostring, rc) integer, optional, intent(out) :: rc integer :: status - call cft % check(_RC) + if(cft % is_valid) then + isostring = convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime) + _RETURN(_SUCCESS) + end if - isostring = convert_CF_Time_datetime_string_to_ISO8601(cft % base_datetime) + _RETURN(_FAILURE) - _RETURN(_SUCCESS) - end subroutine extract_ISO8601_from_CF_Time_cf_time subroutine extract_CF_Time_duration_cf_time_real(cft, duration, rc) @@ -132,11 +137,12 @@ subroutine extract_CF_Time_duration_cf_time_real(cft, duration, rc) integer, optional, intent(out) :: rc integer :: status - call cft % check(_RC) - - duration = cft % duration + if(cft % is_valid) then + duration = cft % duration + _RETURN(_SUCCESS) + end if - _RETURN(_SUCCESS) + _RETURN(_FAILURE) end subroutine extract_CF_Time_duration_cf_time_real @@ -146,11 +152,12 @@ subroutine extract_CF_Time_duration_cf_time_integer(cft, duration, rc) integer, optional, intent(out) :: rc integer :: status - call cft % check(_RC) - - duration = cft % duration + if(cft % is_valid) then + duration = cft % duration + _RETURN(_SUCCESS) + end if - _RETURN(_SUCCESS) + _RETURN(_FAILURE) end subroutine extract_CF_Time_duration_cf_time_integer @@ -160,11 +167,12 @@ subroutine extract_CF_Time_unit_cf_time(cft, time_unit, rc) integer, optional, intent(out) :: rc integer :: status - call cft % check(_RC) - - time_unit = cft % time_unit + if(cft % is_valid) then + time_unit = cft % time_unit + _RETURN(_SUCCESS) + end if - _RETURN(_SUCCESS) + _RETURN(_FAILURE) end subroutine extract_CF_Time_unit_cf_time @@ -172,8 +180,9 @@ subroutine extract_CF_Time_unit_units(units, time_unit, rc) character(len=*), intent(in) :: units character(len=MAX_CHARACTER_LENGTH), intent(out) :: time_unit integer, optional, intent(out) :: rc + integer :: status - call extract_CF_Time_unit(CF_Time(0, units), time_unit, _RC) + call extract_CF_Time_unit(CF_Time_Integer(0, units), time_unit, _RC) _RETURN(_SUCCESS) @@ -186,15 +195,18 @@ subroutine convert_CF_Time_to_datetime_duration_integer(cft, dt_duration, rc) integer :: status integer(kind(TIME_UNIT)) :: tu - call cft % check(_RC) + if(.not. cft % is_valid) then + _RETURN(_FAILURE) + end if - tu = time_unit(cft % time_units()) + tu = get_time_unit(cft % time_unit) if(tu == TIME_UNIT_UNKNOWN) then - _FAIL('Unrecognized time unit in CF Time') +! _FAIL('Unrecognized time unit in CF Time') + _RETURN(_FAILURE) endif call dt_duration % set_value(tu, cft % duration) - + _RETURN(_SUCCESS) end subroutine convert_CF_Time_to_datetime_duration_integer @@ -206,11 +218,14 @@ subroutine convert_CF_Time_to_datetime_duration_real(cft, dt_duration, rc) integer :: status integer(kind(TIME_UNIT)) :: tu - call cft % check(_RC) + if(.not. cft % is_valid) then + _RETURN(_FAILURE) + end if - tu = get_time_unit(cft % time_units()) + tu = get_time_unit(cft % time_unit) if(tu == TIME_UNIT_UNKNOWN) then - _FAIL('Unrecognized time unit in CF Time') +! _FAIL('Unrecognized time unit in CF Time') + _RETURN(_FAILURE) endif call dt_duration % set_value(tu, cft % duration) @@ -226,7 +241,7 @@ subroutine convert_CF_Time_to_datetime_duration_integer_duration(duration, units integer, optional, intent(out) :: rc integer :: status - call convert_CF_Time_to_datetime_duration(CF_Time(duration, units), dt_duration, _RC) + call convert_CF_Time_to_datetime_duration(CF_Time_Integer(duration, units), dt_duration, _RC) _RETURN(_SUCCESS) @@ -239,7 +254,7 @@ subroutine convert_CF_Time_to_datetime_duration_real_duration(duration, units, d integer, optional, intent(out) :: rc integer :: status - call convert_CF_Time_to_datetime_duration(CF_Time(duration, units), dt_duration, _RC) + call convert_CF_Time_to_datetime_duration(CF_Time_Real(duration, units), dt_duration, _RC) _RETURN(_SUCCESS) @@ -263,12 +278,12 @@ function convert_CF_Time_datetime_string_to_ISO8601(datetime_string) result(isod call split(trim(remainder), part(MINUTE), remainder, TIME_DELIM) part(SECOND) = trim(remainder) - call update_datetime(datetime, part(YEAR), 4, DATE_DELIM) - call update_datetime(datetime, part(MONTH), 2, DATE_DELIM) - call update_datetime(datetime, part(DAY), 2, ISO_DELIM) - call update_datetime(datetime, part(HOUR), 2, TIME_DELIM) - call update_datetime(datetime, part(MINUTE), 2, TIME_DELIM) - call update_datetime(datetime, part(SECOND), 2) + call update_datetime(isodatetime, part(YEAR), 4, DATE_DELIM) + call update_datetime(isodatetime, part(MONTH), 2, DATE_DELIM) + call update_datetime(isodatetime, part(DAY), 2, ISO_DELIM) + call update_datetime(isodatetime, part(HOUR), 2, TIME_DELIM) + call update_datetime(isodatetime, part(MINUTE), 2, TIME_DELIM) + call update_datetime(isodatetime, part(SECOND), 2) contains @@ -308,13 +323,13 @@ function construct_cf_time_integer(duration, units) result (cft) integer, intent(in) :: duration character(len=*), intent(in) :: units type(CF_Time_Integer) :: cft - integer :: status - if(duration < 0) return + cft % is_valid = (duration >= 0) + if(.not. cft % is_valid) return cft % duration = duration - call initialize_cf_time(cft, units, rc=status) - cft % is_valid = status + call initialize_cf_time(cft, units) + cft % is_valid = .TRUE. end function construct_cf_time_integer @@ -322,49 +337,38 @@ function construct_cf_time_real(duration, units) result (cft) real(kind=R64), intent(in) :: duration character(len=*), intent(in) :: units type(CF_Time_Real) :: cft - integer :: status - if(duration < 0) return + cft % is_valid = (duration >= 0.0) + if(.not. cft % is_valid) return cft % duration = duration - call initialize_cf_time(cft, units, rc=status) - cft % is_valid = status + call initialize_cf_time(cft, units) + cft % is_valid = .TRUE. end function construct_cf_time_real - subroutine initialize_cf_time(cft, units, rc) + subroutine initialize_cf_time(cft, units) class(CF_Time), intent(inout) :: cft character(len=*), intent(in) :: units - integer, optional, intent(out) :: rc - character(len=MAX_CHARACTER_LENGTH) :: token(2), remainder + character(len=MAX_CHARACTER_LENGTH) :: token, remainder integer :: i - if(present(rc)) rc = _FAILURE - remainder = units - - do i = 1, size(token) - if(len_trim(remainder) == 0) return - call split(trim(remainder), token(i), remainder, CF_DELIM) - end do - - cft % time_unit = token(1) - cft % base_datetime = token(3) - - if(present(rc)) rc = _SUCCESS + if(len_trim(remainder) == 0) return + call split(trim(remainder), token, remainder, CF_DELIM) + cft % time_unit = token + call split(trim(remainder), token, remainder, CF_DELIM) + cft % base_datetime = remainder end subroutine initialize_cf_time - subroutine check_cf_time(this, rc) - class(CF_Time), intent(in) :: this - integer, optional, intent(out) :: rc - integer :: status - - if(.not. this % is_valid) then - _FAIL("Invalid CF_Time") - end if - - end subroutine check_cf_time +! logical function check_cf_time(this) +! class(CF_Time), intent(in) :: this +! integer :: status +! +! check_cf_time = this % is_valid +! +! end function check_cf_time ! END CONSTRUCTORS @@ -416,7 +420,7 @@ end subroutine split_characters function remove_zero_pad(isostring) result(unpadded) character(len=*), intent(in) :: isostring character(len=len(isostring)) :: unpadded - character(len=DT_PART_WIDTH) :: part(NUM_DT_PARTS) + character(len=:), allocatable :: part(:) character(len=len(isostring)) :: fraction_part integer :: i diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index d3a001da7d78..8d5452604ef7 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -57,6 +57,7 @@ module MAPL_DateTime_Parsing public :: is_positive_digit public :: MAX_CHARACTER_LENGTH public :: is_time_unit + public :: get_time_unit public :: YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, TIME_UNIT_UNKNOWN public :: TIME_UNIT, NUM_TIME_UNITS @@ -205,16 +206,17 @@ module MAPL_DateTime_Parsing ! NUMBER HANDLING PROCEDURES ! Return true if factor divides dividend evenly, false otherwise - pure logical function multipleof(factor, dividend) - integer, intent(in) :: factor + pure logical function multipleof(dividend, factor) integer, intent(in) :: dividend + integer, intent(in) :: factor ! mod returns the remainder of dividend/factor, ! and if it is 0, factor divides dividend evenly if(factor /= 0) then ! To avoid divide by 0 - multipleof = mod(dividend, factor)==0 + multipleof = mod(dividend, factor) == 0 else multipleof = .FALSE. endif + end function multipleof pure logical function is_in_closed_interval(n, clint) @@ -1040,6 +1042,7 @@ end subroutine set_real_value_datetime_duration ! END TYPE-BOUND METHODS + !wdb deleteme Not testing. May not be necessary. subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) character(len=*), intent(in) :: datetime_string character(len=:), allocatable, intent(out) :: iso_string @@ -1058,13 +1061,25 @@ subroutine convert_to_ISO8601DateTime(datetime_string, iso_string, rc) character(len=*), parameter :: ISO_POINT = '.' character(len=len(datetime_string)) :: undelimited character(len=:), allocatable :: intermediate + character(len=2) :: int_length + integer :: io_stat integer :: undelimited_length + character(len=80) :: msg + integer :: status iso_string = datetime_string undelimited = adjustl(undelimit_all(datetime_string)) undelimited_length=len_trim(undelimited) - if(undelimited_length >= MIN_LEN) then - _FAIL('datetime_string is too short: ') + if(undelimited_length < MIN_LEN) then +! msg = 'datetime_string is too short' +! write(int_length, fmt='(I2)', iostat=io_stat) undelimited_length +! if(io_stat == 0) msg = trim(msg) // ': ' // trim(int_length) +! write(int_length, fmt = '(I2)', iostat = io_stat) MIN_LEN +! if(io_stat == 0) msg = trim(msg) // ' < ' // trim(int_length) + _RETURN(_FAILURE) +! _FAIL(msg) !wdb fixme and delete next 2 lines +! if(present(rc)) rc = -1 +! return end if intermediate = undelimited(N(1,YY):N(2,YY)) // ISO_DD // & @@ -1231,51 +1246,74 @@ end function convert_lengths_to_indices ! TIME_UNIT ==================================================================== - function get_time_unit(unit_name, check_plural) result(n) + function get_time_unit(unit_name, check_plural) result(unit_num) character(len=*), intent(in) :: unit_name logical, optional, intent(in) :: check_plural + integer(kind(TIME_UNIT)) :: unit_num character(len=:), allocatable :: unit_name_ logical :: check_plural_ = .TRUE. character(len=:), pointer, save :: tunits(:) character(len=:), allocatable :: tunit character, parameter :: PLURAL = 's' - integer :: n, i + integer(kind(TIME_UNIT)) :: i + character(len=*), parameter :: IFMT = '(A,I1)' + character(len=*), parameter :: LFMT = '(A,L)' + print *, 'Entering get_time_unit' check_plural_ = .TRUE. if(present(check_plural)) check_plural_ = check_plural + write(*, fmt=LFMT) 'check_plural_: ', check_plural_ unit_name_ = trim(unit_name) + print *, 'unit_name_ = ' // unit_name_ tunits = get_time_units() + do i = 1, size(tunits) + write(*, '(A,I1,A)') 'i = ', i, ', tunits(i) = ' // tunits(i) + end do + print *, 'Have tunits' - n = TIME_UNIT_UNKNOWN + unit_num = TIME_UNIT_UNKNOWN do i = 1, NUM_TIME_UNITS + write(*, fmt=IFMT) 'i = ', i tunit = trim(tunits(i)) + print *, 'tunit = ' // tunit + write(*, fmt=LFMT) 'tunit == unit_name_: ', (tunit == unit_name_) + write(*, fmt=LFMT) 'check_plural_ .and. ((tunit // PLURAL) == unit_name_): ', (check_plural_ .and. ((tunit // PLURAL) == unit_name_)) if((tunit == unit_name_) .or. (check_plural_ .and. ((tunit // PLURAL) == unit_name_))) then - n = i + print *, 'Match' + unit_num = i + write(*, fmt=IFMT) 'unit_num = ', unit_num exit end if end do - contains + end function get_time_unit - function get_time_units() result(units) - character(len=:), pointer :: units(:) - logical, save :: initialized = .FALSE. - - if(.not. initialized) then - time_units(YEAR) = "year" - time_units(MONTH) = "month" - time_units(DAY) = "day" - time_units(HOUR) = "hour" - time_units(MINUTE) = "minute" - time_units(SECOND) = "second" - initialized = .TRUE. - end if + function get_time_units() result(units) + character(len=len(time_units(1))) :: units(size(time_units)) - units => time_units + print *, 'Entering get_time_units()' + call initialize_time_units() + units = time_units + print *, 'Exiting get_time_units()' - end function get_time_units + end function get_time_units - end function get_time_unit + subroutine initialize_time_units() + logical, save :: initialized = .FALSE. + + print *, 'Entering initialize_time_units()' + if(initialized) return + time_units(YEAR) = "year" + time_units(MONTH) = "month" + time_units(DAY) = "day" + time_units(HOUR) = "hour" + time_units(MINUTE) = "minute" + time_units(SECOND) = "second" + + initialized = .TRUE. + print *, 'Exiting initialize_time_units()' + + end subroutine initialize_time_units logical function is_time_unit(string) character(len=*), intent(in) :: string diff --git a/shared/tests/CMakeLists.txt b/shared/tests/CMakeLists.txt index ae9971ff72c3..b9b167d082ca 100644 --- a/shared/tests/CMakeLists.txt +++ b/shared/tests/CMakeLists.txt @@ -7,6 +7,7 @@ set (test_srcs test_FileSystemUtilities.pf # test_MAPL_ISO8601_DateTime.pf test_MAPL_DateTime_Parsing.pf + test_MAPL_CF_Time.pf ) diff --git a/shared/tests/test_MAPL_CF_Time.pf b/shared/tests/test_MAPL_CF_Time.pf new file mode 100644 index 000000000000..9730ad1c074a --- /dev/null +++ b/shared/tests/test_MAPL_CF_Time.pf @@ -0,0 +1,128 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" + +module test_MAPL_CF_Time + use MAPL_ExceptionHandling + use MAPL_CF_Time + use pfunit + use MAPL_DateTime_Parsing + use, intrinsic :: iso_fortran_env, only : R64 => real64 + + implicit none + + integer, parameter :: SUCCESS = 0 !wdb deleteme + +contains + + !@test + subroutine test_convert_CF_Time_to_datetime_duration() + type(CF_Time_Integer) :: cfti + type(CF_Time_Real) :: cftr + integer :: iduration = 1800 + real(R64) :: rduration = 1800.0 + type(datetime_duration) :: dt_dur + character(len=*), parameter :: time_unit = 'seconds' + character(len=*), parameter :: base_datetime = '1999-12-31 23:29:59' + character(len=*), parameter :: units = time_unit // ' since ' // base_datetime + integer :: status + + call convert_CF_Time_to_datetime_duration(iduration, units, dt_dur, rc = status) +! @assertEqual(SUCCESS, status, 'Conversion unsuccessful') +! @assertEqual(iduration, dt_dur % second, 'Duration does not match.') + + call convert_CF_Time_to_datetime_duration(rduration, units, dt_dur, rc = status) + @assertEqual(SUCCESS, status, 'Conversion unsuccessful') + @assertEqual(rduration, dt_dur % second_real, 'Duration does not match.') + + cfti = CF_Time_Integer(iduration, units) + @assertTrue(cfti % is_valid, 'Invalid CF_Time_Integer') + call convert_CF_Time_to_datetime_duration(cfti, dt_dur, rc = status) + @assertEqual(SUCCESS, status, 'Conversion unsuccessful') + @assertEqual(iduration, dt_dur % second, 'Duration does not match.') + + cftr = CF_Time_Real(rduration, units) + @assertTrue(cftr % is_valid, 'Invalid CF_Time_Real') + call convert_CF_Time_to_datetime_duration(cftr, dt_dur, rc = status) + @assertEqual(SUCCESS, status, 'Conversion unsuccessful') + @assertEqual(rduration, dt_dur % second_real, 'Duration does not match.') + + end subroutine test_convert_CF_Time_to_datetime_duration + + @test + subroutine test_construct_cf_time() + type(CF_Time_Integer) :: cfti + type(CF_Time_Real) :: cftr + integer :: iduration = 1800 + real(R64) :: rduration = 1800.0 + character(len=*), parameter :: time_unit = 'seconds' + character(len=*), parameter :: base_datetime = '1999-12-31 23:29:59' + character(len=*), parameter :: units = time_unit // ' since ' // base_datetime + + cfti = CF_Time_Integer(iduration, units) + @assertTrue(cfti % is_valid, 'Invalid CF_Time_Integer') + @assertEqual(iduration, cfti % duration, 'Duration does not match.') + @assertEqual(time_unit, cfti % time_unit, 'Time unit does not match.') + @assertEqual(base_datetime, cfti % base_datetime, 'base_datetime does not match.') + + cftr = CF_Time_Real(rduration, units) + @assertTrue(cftr % is_valid, 'Invalid CF_Time_Real') + @assertEqual(rduration, cftr % duration, 'Duration does not match.') + @assertEqual(time_unit, cftr % time_unit, 'Time unit does not match.') + @assertEqual(base_datetime, cftr % base_datetime, 'base_datetime does not match.') + + end subroutine test_construct_cf_time + +! @test +! subroutine test_multipleof() +! @assertTrue(multipleof(21, 7)) +! @assertFalse(multipleof(22, 7)) +! end subroutine test_multipleof + +! @test +! subroutine test_get_integer_digit_from_string() +! @assertEqual(NONDIGIT, get_integer_digit_from_string(digit, len(digit)+1)) +! end subroutine test_get_integer_digit_from_string + subroutine test_extract_ISO8601_from_CF_Time() + type(CF_Time_Integer) :: cfti + integer, parameter :: duration = 1800 + character(len=*), parameter :: time_unit = 'seconds' + character(len=*), parameter :: base_datetime = '1999-12-31 23:29:59' + character(len=*), parameter :: units = time_unit // ' since ' // base_datetime + character(len=len(base_datetime)), parameter :: expected = '1999-12-31T23:29:59' + character(len=MAX_CHARACTER_LENGTH) :: isostring + integer :: status + + call extract_ISO8601_from_CF_Time(units, isostring, rc = status) + @assertEqual(SUCCESS, status, 'Failed to extract string from units') + @assertEqual(expected, isostring, 'Actual string from units does not match expected string.') + + cfti = CF_Time_Integer(duration, units) + @assertTrue(cfti % is_valid, 'Invalid CF_Time_Integer') + call extract_ISO8601_from_CF_Time(units, isostring, rc = status) + @assertEqual(SUCCESS, status, 'Failed to extract string from CF_Time') + @assertEqual(expected, isostring, 'Actual string from CF_Time does not match expected string.') + + end subroutine test_extract_ISO8601_from_CF_Time + + subroutine test_extract_CF_Time_unit() + type(CF_Time_Integer) :: cfti + integer :: duration = 0 + character(len=*), parameter :: time_unit = 'seconds' + character(len=*), parameter :: base_datetime = '1999-12-31 23:29:59' + character(len=*), parameter :: units = time_unit // ' since ' // base_datetime + character(len=MAX_CHARACTER_LENGTH) :: actual + integer :: status + + call extract_CF_Time_unit(units, actual, rc = status) + @assertEqual(SUCCESS, status, 'Failed to extract time unit from units') + @assertEqual(time_unit, actual, 'Actual time unit does not match expected time unit.') + + cfti = CF_Time_Integer(duration, units) + @assertTrue(cfti % is_valid, 'Invalid CF_Time_Integer') + call extract_CF_Time_unit(cfti, actual, rc = status) + @assertEqual(SUCCESS, status, 'Failed to extract time unit from CF_Time') + @assertEqual(time_unit, actual, 'Actual time unit does not match expected time unit.') + + end subroutine test_extract_CF_Time_unit + +end module test_MAPL_CF_Time diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index c05f98131b3a..119faa52e5da 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -8,6 +8,8 @@ module test_MAPL_DateTime_Parsing use MAPL_ExceptionHandling use MAPL_DateTime_Parsing use pfunit + use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 + implicit none character(len=*), parameter :: DATE_DELIMITER = '-' @@ -216,6 +218,14 @@ contains integer, parameter :: TIMEWIDTH1 = len_trim(UNDELIMITED_TIME1) integer, parameter :: TIMEWIDTH2 = len_trim(UNDELIMITED_TIME2) + character(len=*), parameter :: cf_datetime_string_A = '2023-04-23 21:05:37' + character(len=*), parameter :: expected_A = '20230423210537' + character(len=*), parameter :: cf_datetime_string_B= '2023-04-23 21:05:37.337' + character(len=*), parameter :: expected_B = '20230423210537337' + character(len=*), parameter :: undelimited_datetime_string_C = '20230423210537' + character(len=*), parameter :: fail_D = '2023-4-23 21:05:37' + character(len=*), parameter :: fail_E = '2023-04-23 21:5:37' + @assertEqual(trim(UNDELIMITED_DATE), trim(undelimit_all(DATE))) @assertEqual(DATEWIDTH, len_trim(UNDELIMITED_DATE)) @assertEqual(trim(UNDELIMITED_TIME1), trim(undelimit_all(TIME1))) @@ -224,6 +234,11 @@ contains @assertEqual(TIMEWIDTH2, len_trim(UNDELIMITED_TIME2)) @assertEqual(trim(UNDELIMITED_TIME1), trim(undelimit_all(UNDELIMITED_TIME1))) @assertEqual('', trim(undelimit_all(''))) + + @assertEqual(trim(expected_A), trim(undelimit_all(cf_datetime_string_A)), 'Mismatch A') + @assertEqual(trim(expected_B), trim(undelimit_all(cf_datetime_string_B)), 'Mismatch B') + @assertEqual(trim(undelimited_datetime_string_C), trim(undelimit_all(undelimited_datetime_string_C)), 'Mismatch C') + end subroutine test_undelimit_all @test @@ -570,39 +585,39 @@ contains @assertFalse(tf % is_valid(), 'tf should not be valid.') end subroutine test_are_valid_time_fields - @test +! @test subroutine test_convert_to_ISO8601DateTime() + character(len=*), parameter :: cf_datetime_string_A = '2023-04-23 21:05:37' character(len=*), parameter :: expected_A = '2023-04-23T21:05:37' + character(len=*), parameter :: cf_datetime_string_B= '2023-04-23 21:05:37.337' character(len=*), parameter :: expected_B = '2023-04-23T21:05:37.337' + character(len=*), parameter :: undelimited_datetime_string_C = '20230423210537' + character(len=*), parameter :: fail_D = '2023-4-23 21:05:37' + character(len=*), parameter :: fail_E = '2023-04-23 21:5:37' character(len=:), allocatable :: output character(len=MAX_LEN) :: actual integer :: status - call convert_to_ISO8601DateTime('2023-04-23 21:05:37', output, rc = status) - actual = trim(output) - @assertEqual(status, 0, 'Convert failed') - @assertEqual(expected_A, trim(actual), 'Datetime strings do not match.') - - call convert_to_ISO8601DateTime('20230423 210537', output, rc = status) + call convert_to_ISO8601DateTime(cf_datetime_string_A, output, rc = status) + @assertEqual(status, 0, 'Conversion A failed: ' // trim(cf_datetime_string_A)) actual = trim(output) - @assertEqual(status, 0, 'Convert failed') @assertEqual(expected_A, trim(actual), 'Datetime strings do not match.') - call convert_to_ISO8601DateTime('2023-04-23 21:05:37.337', output, rc = status) + call convert_to_ISO8601DateTime(cf_datetime_string_B, output, rc = status) + @assertEqual(status, 0, 'Conversion B failed: ' // trim(cf_datetime_string_B)) actual = trim(output) - @assertEqual(status, 0, 'Convert failed') @assertEqual(expected_B, trim(actual), 'Datetime strings do not match.') - call convert_to_ISO8601DateTime('20230423210537337', output, rc = status) + call convert_to_ISO8601DateTime(undelimited_datetime_string_C, output, rc = status) + @assertEqual(status, 0, 'Conversion C failed: ' // trim(undelimited_datetime_string_C)) actual = trim(output) - @assertEqual(status, 0, 'Convert failed') - @assertEqual(expected_B, trim(actual), 'Datetime strings do not match.') + @assertEqual(expected_A, trim(actual), 'Datetime strings do not match.') - call convert_to_ISO8601DateTime('2023-4-23 21:05:37', output, rc = status) - @assertFalse(status == 0, 'Failed to catch illegal value.') + call convert_to_ISO8601DateTime(fail_D, output, rc = status) + @assertFalse(status == 0, 'Failed to catch illegal value - D') - call convert_to_ISO8601DateTime('2023-04-23 21:5:37', output, rc = status) - @assertFalse(status == 0, 'Failed to catch illegal value.') + call convert_to_ISO8601DateTime(fail_E, output, rc = status) + @assertFalse(status == 0, 'Failed to catch illegal value - E.') end subroutine test_convert_to_ISO8601DateTime @@ -628,44 +643,143 @@ contains end subroutine test_construct_datetime_duration subroutine test_set_year_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 2001 + d = datetime_duration() + call d % set_year(expected) + @assertEqual(expected, d % year, 'Value not set correctly') + end subroutine test_set_year_datetime_duration subroutine test_set_month_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 3 + d = datetime_duration() + call d % set_month(expected) + @assertEqual(expected, d % month, 'Value not set correctly') + end subroutine test_set_month_datetime_duration subroutine test_set_day_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 20 + d = datetime_duration() + call d % set_day(expected) + @assertEqual(expected, d % day, 'Value not set correctly') + end subroutine test_set_day_datetime_duration subroutine test_set_hour_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 3 + d = datetime_duration() + call d % set_hour(expected) + @assertEqual(expected, d % hour, 'Value not set correctly') + end subroutine test_set_hour_datetime_duration subroutine test_set_minute_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 10 + d = datetime_duration() + call d % set_minute(expected) + @assertEqual(expected, d % minute, 'Value not set correctly') + end subroutine test_set_minute_datetime_duration subroutine test_set_second_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 1800 + d = datetime_duration() + call d % set_second(expected) + @assertEqual(expected, d % second, 'Value not set correctly') + end subroutine test_set_second_datetime_duration subroutine test_set_hour_real_datetime_duration() + type(datetime_duration) :: d + real(R64) :: expected + + expected = 3.0 + d = datetime_duration() + call d % set_hour_real(expected) + @assertEqual(expected, d % hour_real, 'Value not set correctly') + end subroutine test_set_hour_real_datetime_duration subroutine test_set_minute_real_datetime_duration() + type(datetime_duration) :: d + real(R64) :: expected + + expected = 10.0 + d = datetime_duration() + call d % set_minute_real(expected) + @assertEqual(expected, d % minute_real, 'Value not set correctly') + end subroutine test_set_minute_real_datetime_duration subroutine test_set_second_real_datetime_duration() + type(datetime_duration) :: d + real(R64) :: expected + + expected = 1800.0 + d = datetime_duration() + call d % set_second_real(expected) + @assertEqual(expected, d % second_real, 'Value not set correctly') + end subroutine test_set_second_real_datetime_duration subroutine test_set_real_value_datetime_duration() + type(datetime_duration) :: d + real(R64) :: expected + + expected = 1800.0 + d = datetime_duration() + call d % set_value(SECOND, expected) + @assertEqual(expected, d % second_real, 'Value not set correctly') + end subroutine test_set_real_value_datetime_duration subroutine test_set_integer_value_datetime_duration() + type(datetime_duration) :: d + integer :: expected + + expected = 1800 + d = datetime_duration() + call d % set_value(SECOND, expected) + @assertEqual(expected, d % second, 'Value not set correctly') + end subroutine test_set_integer_value_datetime_duration subroutine test_is_valid_datestring() end subroutine test_is_valid_datestring subroutine test_is_in_char_set() + character(len=*), parameter :: DIGITS = '1234567890' + character :: ch + + ch = '0' + @assertTrue(is_in_char_set(ch, DIGITS), 'Character not found') + ch = 'A' + @assertFalse(is_in_char_set(ch, DIGITS), 'Character is not in set') + end subroutine test_is_in_char_set + subroutine test_find_delta() + end subroutine test_find_delta + subroutine test_find_delta_datestring() end subroutine test_find_delta_datestring @@ -681,8 +795,80 @@ contains subroutine test_convert_lengths_to_indices() end subroutine test_convert_lengths_to_indices - subroutine test_test_get_time_unit() - end subroutine test_test_get_time_unit + @test + subroutine test_get_time_units() + integer(kind(TIME_UNIT)) :: unit_num + character(MAX_CHARACTER_LENGTH) :: unit_name + character(len=:), allocatable :: units(:) + + units = get_time_units() + + do unit_num = 1, size(time_units) + unit_name = time_units(unit_num) + @assertEqual(unit_name, units(unit_num), 'Time unit initialized incorrectly.') + end do + + end subroutine test_get_time_units + + @test + subroutine test_get_time_unit() + integer(kind(TIME_UNIT)) :: expected, actual + character(len=8) :: unit_name + + unit_name = 'year' + expected = YEAR + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'month' + expected = MONTH + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'day' + expected = DAY + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'hour' + expected = HOUR + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'minute' + expected = MINUTE + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'second' + expected = SECOND + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + unit_name = unit_name // 's' + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + unit_name = 'furlong' + expected = TIME_UNIT_UNKNOWN + actual = get_time_unit(unit_name) + @assertEqual(expected, actual, 'Mismatch for ' // unit_name) + + end subroutine test_get_time_unit subroutine test_test_is_time_unit end subroutine test_test_is_time_unit From b374ebcab96343942693c2d52d9cd0cdaf6562ed Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 19 Sep 2023 22:45:30 -0400 Subject: [PATCH 22/32] Fix failed tests --- base/MAPL_DateTime_Parsing_ESMF.F90 | 18 +- base/MAPL_NetCDF.F90 | 3 + base/tests/test_MAPL_NetCDF.pf | 91 +++++++-- shared/MAPL_CF_Time.F90 | 1 + shared/MAPL_DateTime_Parsing.F90 | 223 +++++++++++++-------- shared/tests/test_MAPL_CF_Time.pf | 16 +- shared/tests/test_MAPL_DateTime_Parsing.pf | 36 ++-- 7 files changed, 254 insertions(+), 134 deletions(-) diff --git a/base/MAPL_DateTime_Parsing_ESMF.F90 b/base/MAPL_DateTime_Parsing_ESMF.F90 index 76834995de86..24e7ed8e4b23 100644 --- a/base/MAPL_DateTime_Parsing_ESMF.F90 +++ b/base/MAPL_DateTime_Parsing_ESMF.F90 @@ -25,25 +25,25 @@ subroutine set_ESMF_TimeInterval_from_datetime_duration(interval, duration, rc) ! Get duration(s) from datetime_duration ! Set ESMF_TimeInterval - if(duration % year_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % year, _RC) - if(duration % month_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % month, _RC) - if(duration % day_is_set) call ESMF_TimeIntervalSet(interval, yy = duration % day, _RC) + if(duration % year_is_set()) call ESMF_TimeIntervalSet(interval, yy = duration % year, _RC) + if(duration % month_is_set()) call ESMF_TimeIntervalSet(interval, yy = duration % month, _RC) + if(duration % day_is_set()) call ESMF_TimeIntervalSet(interval, yy = duration % day, _RC) - if(duration % hour_is_real) then + if(duration % hour_is_real()) then call ESMF_TimeIntervalSet(interval, h_r8 = duration % hour_real, _RC) - else if(duration % hour_is_set) then + else if(duration % hour_is_set()) then call ESMF_TimeIntervalSet(interval, h = duration % hour, _RC) end if - if(duration % minute_is_real) then + if(duration % minute_is_real()) then call ESMF_TimeIntervalSet(interval, m_r8 = duration % minute_real, _RC) - else if(duration % minute_is_set) then + else if(duration % minute_is_set()) then call ESMF_TimeIntervalSet(interval, m = duration % minute, _RC) end if - if(duration % second_is_real) then + if(duration % second_is_real()) then call ESMF_TimeIntervalSet(interval, s_r8 = duration % second_real, _RC) - else if(duration % second_is_set) then + else if(duration % second_is_set()) then call ESMF_TimeIntervalSet(interval, s = duration % second, _RC) end if diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index ce802c9857ea..8c6eccc6b9d7 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -4,6 +4,9 @@ ! NetCDF datetime is: {integer, character(len=*)} ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} +!wdb fixme deleteme Switch kind to ESMF_KIND_R8 +!wdb fixme deleteme alias real kind to ESMF_KIND_R8 +!wdb fixme deleteme Need to delete extra prints module MAPL_NetCDF use, intrinsic :: iso_fortran_env, only: R64 => real64 diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 4fd47350fe50..91e04ee98861 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -58,9 +58,15 @@ contains integer :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=*), parameter :: UNITS = 'seconds' + character(len=*), parameter :: NOT_EQUAL = ' /= ' character(len=:), allocatable :: tunit, units_string - type(ESMF_Time) :: time, etime, btime + type(ESMF_Time) :: time, etime, btime, ebtime type(ESMF_TimeInterval) :: time_interval + character(len=ESMF_MAXSTR) :: expected_base_datetime_string + character(len=ESMF_MAXSTR) :: expected_datetime_string + character(len=ESMF_MAXSTR) :: actual_base_datetime_string + character(len=ESMF_MAXSTR) :: actual_datetime_string + character(len=:), allocatable :: msg_time, msg_base_time, msg_tunit integer :: status yy = 1999 @@ -74,18 +80,25 @@ contains units_string = UNITS // ' since 1999-12-31 23:29:59' call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimeGet(etime, timeString = expected_datetime_string, rc=status) + + call ESMF_TimeSet(ebtime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) @assertTrue(status == _SUCCESS, 'Unable to create expected base ESMF_Time') + call ESMF_TimeGet(ebtime, timeString = expected_base_datetime_string, rc=status) call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & time1 = time, tunit = tunit, rc = status) @assertTrue(status == _SUCCESS, 'Conversion failed') + call ESMF_TimeGet(btime, timeString = actual_base_datetime_string, rc=status) + call ESMF_TimeGet(time, timeString = actual_datetime_string, rc=status) + msg_time = trim(actual_datetime_string) // NOT_EQUAL // trim(expected_datetime_string) + msg_base_time = trim(actual_base_datetime_string) // NOT_EQUAL // trim(expected_base_datetime_string) + msg_tunit = trim(tunit) // NOT_EQUAL // trim(UNITS) - @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') - @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") - - call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') - @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') + @assertTrue(ESMF_Times_Equal(ebtime, btime), 'base ESMF_Time values do not match: ' // msg_base_time) + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match: " // msg_tunit) + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match: ' // msg_time) end subroutine test_convert_NetCDF_DateTime_to_ESMF_integer @@ -94,9 +107,15 @@ contains real(kind=ESMF_KIND_R8) :: duration integer :: yy, mm, dd, h, m, s, m_time character(len=*), parameter :: UNITS = 'seconds' + character(len=*), parameter :: NOT_EQUAL = ' /= ' character(len=:), allocatable :: tunit, units_string - type(ESMF_Time) :: time, etime, btime + type(ESMF_Time) :: time, etime, btime, ebtime type(ESMF_TimeInterval) :: time_interval + character(len=ESMF_MAXSTR) :: expected_base_datetime_string + character(len=ESMF_MAXSTR) :: expected_datetime_string + character(len=ESMF_MAXSTR) :: actual_base_datetime_string + character(len=ESMF_MAXSTR) :: actual_datetime_string + character(len=:), allocatable :: msg_time, msg_base_time, msg_tunit integer :: status yy = 1999 @@ -111,17 +130,59 @@ contains call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') + call ESMF_TimeGet(etime, timeString = expected_datetime_string, rc=status) + + call ESMF_TimeSet(ebtime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) + @assertTrue(status == _SUCCESS, 'Unable to create expected base ESMF_Time') + call ESMF_TimeGet(ebtime, timeString = expected_base_datetime_string, rc=status) call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & time1 = time, tunit = tunit, rc = status) @assertTrue(status == _SUCCESS, 'Conversion failed') - - @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') - @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") - - call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) - @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') - @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') + call ESMF_TimeGet(btime, timeString = actual_base_datetime_string, rc=status) + call ESMF_TimeGet(time, timeString = actual_datetime_string, rc=status) + msg_time = trim(actual_datetime_string) // NOT_EQUAL // trim(expected_datetime_string) + msg_base_time = trim(actual_base_datetime_string) // NOT_EQUAL // trim(expected_base_datetime_string) + msg_tunit = trim(tunit) // NOT_EQUAL // trim(UNITS) + + @assertTrue(ESMF_Times_Equal(ebtime, btime), 'base ESMF_Time values do not match: ' // msg_base_time) + @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match: " // msg_tunit) + @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match: ' // msg_time) +! integer :: yy, mm, dd, h, m, s, m_time +! character(len=*), parameter :: UNITS = 'seconds' +! character(len=:), allocatable :: tunit, units_string +! type(ESMF_Time) :: time, etime, btime, ebtime +! type(ESMF_TimeInterval) :: time_interval +! character(len=ESMF_MAXSTR) :: expected_base_datetime_string +! character(len=ESMF_MAXSTR) :: expected_datetime_string +! character(len=ESMF_MAXSTR) :: actual_base_datetime_string +! character(len=ESMF_MAXSTR) :: actual_datetime_string +! character(len=:), allocatable :: msg_time, msg_base_time +! integer :: status +! +! yy = 1999 +! mm = 12 +! dd = 31 +! h = 23 +! m = 29 +! m_time = 59 +! s = 59 +! duration = ( m_time - m ) * SECONDS_PER_MINUTE +! units_string = UNITS // ' since 1999-12-31 23:29:59' +! +! call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) +! @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') +! +! call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & +! time1 = time, tunit = tunit, rc = status) +! @assertTrue(status == _SUCCESS, 'Conversion failed') +! +! @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') +! @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") +! +! call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) +! @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') +! @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_real diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 index a818b07bea42..4d72ede5811c 100644 --- a/shared/MAPL_CF_Time.F90 +++ b/shared/MAPL_CF_Time.F90 @@ -1,5 +1,6 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" +!wdb fixme deleteme Need to delete extra prints module MAPL_CF_Time use, intrinsic :: iso_fortran_env, only : R64 => real64 diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 8d5452604ef7..3ef6fb33136c 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -144,28 +144,48 @@ module MAPL_DateTime_Parsing type :: datetime_duration integer :: year, month, day, hour, minute, second real(kind=R64) :: hour_real, minute_real, second_real - logical :: hour_is_set, minute_is_set, second_is_set - logical :: year_is_set, month_is_set, day_is_set - logical :: hour_is_real, minute_is_real, second_is_real contains - procedure, pass(this) :: set_year => set_year_datetime_duration - procedure, pass(this) :: set_month => set_month_datetime_duration - procedure, pass(this) :: set_day => set_day_datetime_duration - procedure, pass(this) :: set_hour => set_hour_datetime_duration - procedure, pass(this) :: set_minute => set_minute_datetime_duration - procedure, pass(this) :: set_second => set_second_datetime_duration - procedure, pass(this) :: set_hour_real => set_hour_real_datetime_duration - procedure, pass(this) :: set_minute_real => set_minute_real_datetime_duration - procedure, pass(this) :: set_second_real => set_second_real_datetime_duration - procedure, pass(this) :: set_real_value_datetime_duration - procedure, pass(this) :: set_integer_value_datetime_duration - generic :: set_value => set_integer_value_datetime_duration, set_real_value_datetime_duration + procedure, pass(this) :: year_is_set + procedure, pass(this) :: month_is_set + procedure, pass(this) :: day_is_set + procedure, pass(this) :: hour_is_set + procedure, pass(this) :: minute_is_set + procedure, pass(this) :: second_is_set + procedure, pass(this) :: hour_is_real + procedure, pass(this) :: minute_is_real + procedure, pass(this) :: second_is_real + procedure, pass(this) :: set_year => set_year_datetime_duration + procedure, pass(this) :: set_month => set_month_datetime_duration + procedure, pass(this) :: set_day => set_day_datetime_duration + procedure, pass(this) :: set_hour => set_hour_datetime_duration + procedure, pass(this) :: set_minute => set_minute_datetime_duration + procedure, pass(this) :: set_second => set_second_datetime_duration + procedure, pass(this) :: set_hour_real => set_hour_real_datetime_duration + procedure, pass(this) :: set_minute_real => set_minute_real_datetime_duration + procedure, pass(this) :: set_second_real => set_second_real_datetime_duration + procedure, pass(this) :: set_real_value_datetime_duration + procedure, pass(this) :: set_integer_value_datetime_duration + generic :: set_value => set_integer_value_datetime_duration, set_real_value_datetime_duration end type datetime_duration interface datetime_duration module procedure :: construct_datetime_duration end interface datetime_duration + interface unset + module procedure :: unset_integer + module procedure :: unset_real + end interface unset + + interface set_field_value + module procedure :: set_field_value_integer + module procedure :: set_field_value_real + end interface set_field_value + + interface is_set + module procedure :: is_set_integer + module procedure :: is_set_real + end interface is_set ! END DATETIME_DURATION @@ -190,6 +210,8 @@ module MAPL_DateTime_Parsing ! END TIME_UNIT + ! UNSET FIELD + integer, parameter :: UNSET_FIELD = -1 ! Error handling integer, parameter :: INVALID = -1 @@ -447,7 +469,7 @@ end function is_valid_second ! Verify that millisecond is a valid millisecond values pure logical function is_valid_millisecond(millisecond) - integer, intent(in) :: millisecond + integer, intent(in) :: millisecond is_valid_millisecond = millisecond .in. [0, 999] end function is_valid_millisecond @@ -756,27 +778,16 @@ end function construct_time_fields_null function construct_datetime_duration() result(that) type(datetime_duration) :: that - that % year = 0 - that % month = 0 - that % day = 0 - that % hour = 0 - that % minute = 0 - that % second = 0 + call unset(that % year) + call unset(that % month) + call unset(that % day) + call unset(that % hour) + call unset(that % minute) + call unset(that % second) - that % hour_real = 0.0 - that % minute_real = 0.0 - that % second_real = 0.0 - - that % year_is_set = .FALSE. - that % month_is_set = .FALSE. - that % day_is_set = .FALSE. - that % hour_is_set = .FALSE. - that % minute_is_set = .FALSE. - that % second_is_set = .FALSE. - - that % hour_is_real = .FALSE. - that % minute_is_real = .FALSE. - that % second_is_real = .FALSE. + call unset(that % hour_real) + call unset(that % minute_real) + call unset(that % second_real) end function construct_datetime_duration @@ -843,6 +854,51 @@ end function are_valid_time_fields ! DATETIME_DURATION: + logical function year_is_set(this) + class(datetime_duration), intent(in) :: this + year_is_set = is_set(this % year) + end function year_is_set + + logical function month_is_set(this) + class(datetime_duration), intent(in) :: this + month_is_set = is_set(this % month) + end function month_is_set + + logical function day_is_set(this) + class(datetime_duration), intent(in) :: this + day_is_set = is_set(this % day) + end function day_is_set + + logical function hour_is_set(this) + class(datetime_duration), intent(in) :: this + hour_is_set = is_set(this % hour) .or. is_set(this % hour_real) + end function hour_is_set + + logical function minute_is_set(this) + class(datetime_duration), intent(in) :: this + minute_is_set = is_set(this % minute) .or. is_set(this % minute_real) + end function minute_is_set + + logical function second_is_set(this) + class(datetime_duration), intent(in) :: this + second_is_set = is_set(this % second) .or. is_set(this % second_real) + end function second_is_set + + logical function hour_is_real(this) + class(datetime_duration), intent(in) :: this + hour_is_real = this % hour_is_set() .and. is_set(this % hour_real) + end function hour_is_real + + logical function minute_is_real(this) + class(datetime_duration), intent(in) :: this + minute_is_real = this % minute_is_set() .and. is_set(this % minute_real) + end function minute_is_real + + logical function second_is_real(this) + class(datetime_duration), intent(in) :: this + second_is_real = this % second_is_set() .and. is_set(this % second_real) + end function second_is_real + subroutine set_year_datetime_duration(this, val, rc) class(datetime_duration), intent(inout) :: this integer, intent(in) :: val @@ -850,7 +906,6 @@ subroutine set_year_datetime_duration(this, val, rc) integer :: status this % year = val - this % year_is_set = .TRUE. _RETURN(_SUCCESS) @@ -863,7 +918,6 @@ subroutine set_month_datetime_duration(this, val, rc) integer :: status this % month = val - this % month_is_set = .TRUE. _RETURN(_SUCCESS) @@ -876,7 +930,6 @@ subroutine set_day_datetime_duration(this, val, rc) integer :: status this % day = val - this % day_is_set = .TRUE. _RETURN(_SUCCESS) @@ -888,12 +941,7 @@ subroutine set_hour_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % hour_is_set) then - _FAIL('Hour has already been set to a real value.') - end if - - this % hour = val - this % hour_is_set = .TRUE. + call set_field_value(val, this % hour, this % hour_real) _RETURN(_SUCCESS) @@ -905,13 +953,7 @@ subroutine set_hour_real_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % hour_is_set) then - _FAIL('Hour has already been set to an integer value.') - end if - - this % hour_real = val - this % hour_is_set = .TRUE. - this % hour_is_real = .TRUE. + call set_field_value(val, this % hour_real, this % hour) _RETURN(_SUCCESS) @@ -923,12 +965,7 @@ subroutine set_minute_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % minute_is_set) then - _FAIL('Minute has already been set to a real value') - end if - - this % minute = val - this % minute_is_set = .TRUE. + call set_field_value(val, this % minute, this % minute_real) _RETURN(_SUCCESS) @@ -940,13 +977,7 @@ subroutine set_minute_real_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % minute_is_set) then - _FAIL('Minute has already been set to an integer value.') - end if - - this % minute_real = val - this % minute_is_set = .TRUE. - this % minute_is_real = .TRUE. + call set_field_value(val, this % minute_real, this % minute) _RETURN(_SUCCESS) @@ -958,12 +989,7 @@ subroutine set_second_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % second_is_set) then - _FAIL('Minute has already been set to a real value') - end if - - this % second = val - this % second_is_set = .TRUE. + call set_field_value(val, this % second, this % second_real) _RETURN(_SUCCESS) @@ -975,13 +1001,7 @@ subroutine set_second_real_datetime_duration(this, val, rc) integer, optional, intent(out) :: rc integer :: status - if(.not. this % second_is_set) then - _FAIL('Second has already been set to an integer value.') - end if - - this % second_real = val - this % second_is_set = .TRUE. - this % second_is_real = .TRUE. + call set_field_value(val, this % second_real, this % second) _RETURN(_SUCCESS) @@ -1244,6 +1264,46 @@ function convert_lengths_to_indices(length) result(indices) end function convert_lengths_to_indices + subroutine unset_integer(n) + integer, intent(out) :: n + n = UNSET_FIELD + end subroutine unset_integer + + subroutine unset_real(t) + real(kind=R64), intent(out) :: t + t = real(UNSET_FIELD, kind=R64) + end subroutine unset_real + + logical function is_set_integer(n) + integer, intent(in) :: n + is_set_integer = (n /= UNSET_FIELD) + end function is_set_integer + + logical function is_set_real(t) + real(kind=R64), intent(in) :: t + is_set_real = (t /= real(UNSET_FIELD, kind=R64)) + end function is_set_real + + subroutine set_field_value_integer(new_value, integer_value, real_value) + integer, intent(in) :: new_value + integer, intent(out) :: integer_value + real(kind=R64), intent(out) :: real_value + + integer_value = new_value + call unset(real_value) + + end subroutine set_field_value_integer + + subroutine set_field_value_real(new_value, real_value, integer_value) + real(kind=R64), intent(in) :: new_value + real(kind=R64), intent(out) :: real_value + integer, intent(out) :: integer_value + + real_value = new_value + call unset(integer_value) + + end subroutine set_field_value_real + ! TIME_UNIT ==================================================================== function get_time_unit(unit_name, check_plural) result(unit_num) @@ -1265,7 +1325,7 @@ function get_time_unit(unit_name, check_plural) result(unit_num) write(*, fmt=LFMT) 'check_plural_: ', check_plural_ unit_name_ = trim(unit_name) print *, 'unit_name_ = ' // unit_name_ - tunits = get_time_units() + tunits => get_time_units() do i = 1, size(tunits) write(*, '(A,I1,A)') 'i = ', i, ', tunits(i) = ' // tunits(i) end do @@ -1289,11 +1349,12 @@ function get_time_unit(unit_name, check_plural) result(unit_num) end function get_time_unit function get_time_units() result(units) - character(len=len(time_units(1))) :: units(size(time_units)) +! character(len=len(time_units(1))), pointer :: units(size(time_units)) !wdb fixme deleteme + character(len=:), pointer :: units(:) print *, 'Entering get_time_units()' call initialize_time_units() - units = time_units + units => time_units print *, 'Exiting get_time_units()' end function get_time_units diff --git a/shared/tests/test_MAPL_CF_Time.pf b/shared/tests/test_MAPL_CF_Time.pf index 9730ad1c074a..0f2e0721e8f9 100644 --- a/shared/tests/test_MAPL_CF_Time.pf +++ b/shared/tests/test_MAPL_CF_Time.pf @@ -1,6 +1,7 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" +!wdb fixme deleteme Need to delete extra prints module test_MAPL_CF_Time use MAPL_ExceptionHandling use MAPL_CF_Time @@ -14,7 +15,7 @@ module test_MAPL_CF_Time contains - !@test + @test subroutine test_convert_CF_Time_to_datetime_duration() type(CF_Time_Integer) :: cfti type(CF_Time_Real) :: cftr @@ -27,9 +28,6 @@ contains integer :: status call convert_CF_Time_to_datetime_duration(iduration, units, dt_dur, rc = status) -! @assertEqual(SUCCESS, status, 'Conversion unsuccessful') -! @assertEqual(iduration, dt_dur % second, 'Duration does not match.') - call convert_CF_Time_to_datetime_duration(rduration, units, dt_dur, rc = status) @assertEqual(SUCCESS, status, 'Conversion unsuccessful') @assertEqual(rduration, dt_dur % second_real, 'Duration does not match.') @@ -72,16 +70,6 @@ contains end subroutine test_construct_cf_time -! @test -! subroutine test_multipleof() -! @assertTrue(multipleof(21, 7)) -! @assertFalse(multipleof(22, 7)) -! end subroutine test_multipleof - -! @test -! subroutine test_get_integer_digit_from_string() -! @assertEqual(NONDIGIT, get_integer_digit_from_string(digit, len(digit)+1)) -! end subroutine test_get_integer_digit_from_string subroutine test_extract_ISO8601_from_CF_Time() type(CF_Time_Integer) :: cfti integer, parameter :: duration = 1800 diff --git a/shared/tests/test_MAPL_DateTime_Parsing.pf b/shared/tests/test_MAPL_DateTime_Parsing.pf index 119faa52e5da..1d099b90112c 100644 --- a/shared/tests/test_MAPL_DateTime_Parsing.pf +++ b/shared/tests/test_MAPL_DateTime_Parsing.pf @@ -8,7 +8,7 @@ module test_MAPL_DateTime_Parsing use MAPL_ExceptionHandling use MAPL_DateTime_Parsing use pfunit - use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 + use, intrinsic :: iso_fortran_env, only: R64 => real64 implicit none @@ -623,23 +623,29 @@ contains @test subroutine test_construct_datetime_duration() - integer, parameter :: IEX = 0 - real, parameter :: REX = 0.0 + integer, parameter :: IEX = -1 + real(kind=R64), parameter :: REX = real(IEX, kind=R64) logical, parameter :: LEX = .FALSE. type(datetime_duration) :: d d = datetime_duration() - @assertEqual(IEX, d % year, 'year should be 0') - @assertEqual(IEX, d % month, 'month should be 0') - @assertEqual(IEX, d % day, 'day should be 0') - @assertEqual(IEX, d % hour, 'hour should be 0') - @assertEqual(IEX, d % minute, 'minute should be 0') - @assertEqual(IEX, d % second, 'second should be 0') - @assertEqual(REX, d % hour_real, 'hour_real should be 0.0') - @assertEqual(REX, d % minute_real, 'minute_real should be 0.0') - @assertEqual(REX, d % second_real, 'second_real should be 0.0') - @assertFalse(d % hour_is_set, 'hour_is_set should be .FALSE.') - @assertFalse(d % minute_is_set, 'minute_is_set should be .FALSE.') - @assertFalse(d % second_is_set, 'hour_is_set should be .FALSE.') + @assertEqual(IEX, d % year, 'year should be unset') + @assertEqual(IEX, d % month, 'month should be unset') + @assertEqual(IEX, d % day, 'day should be unset') + @assertEqual(IEX, d % hour, 'hour should be unset') + @assertEqual(IEX, d % minute, 'minute should be unset') + @assertEqual(IEX, d % second, 'second should be unset') + @assertEqual(REX, d % hour_real, 'hour_real should be unset') + @assertEqual(REX, d % minute_real, 'minute_real should be unset') + @assertEqual(REX, d % second_real, 'second_real should be unset') + @assertFalse(d % year_is_set(), 'year_is_set should be .FALSE.') + @assertFalse(d % month_is_set(), 'month_is_set should be .FALSE.') + @assertFalse(d % day_is_set(), 'hour_is_set should be .FALSE.') + @assertFalse(d % hour_is_set(), 'hour_is_set should be .FALSE.') + @assertFalse(d % minute_is_set(), 'minute_is_set should be .FALSE.') + @assertFalse(d % second_is_set(), 'hour_is_set should be .FALSE.') + @assertFalse(d % hour_is_real(), 'hour_is_real should be .FALSE.') + @assertFalse(d % minute_is_real(), 'minute_is_real should be .FALSE.') + @assertFalse(d % second_is_real(), 'hour_is_real should be .FALSE.') end subroutine test_construct_datetime_duration subroutine test_set_year_datetime_duration() From dface73a9bc8580e3bceeb2330f1cf1f5744e5a4 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 20 Sep 2023 12:28:26 -0400 Subject: [PATCH 23/32] Clean up --- base/MAPL_NetCDF.F90 | 10 +-- base/tests/test_MAPL_DateTime_Parsing_ESMF.pf | 19 ++---- base/tests/test_MAPL_NetCDF.pf | 35 ---------- shared/MAPL_CF_Time.F90 | 14 ---- shared/MAPL_DateTime_Parsing.F90 | 17 +---- shared/MAPL_ISO8601_DateTime.F90 | 14 ---- shared/tests/test_MAPL_CF_Time.pf | 1 - shared/tests/test_MAPL_DateTime_Parsing.pf | 55 --------------- shared/tests/test_MAPL_ISO8601_DateTime.pf | 67 ------------------- 9 files changed, 8 insertions(+), 224 deletions(-) diff --git a/base/MAPL_NetCDF.F90 b/base/MAPL_NetCDF.F90 index 8c6eccc6b9d7..db198c900508 100644 --- a/base/MAPL_NetCDF.F90 +++ b/base/MAPL_NetCDF.F90 @@ -4,22 +4,14 @@ ! NetCDF datetime is: {integer, character(len=*)} ! {1800, 'seconds since 2010-01-23 18:30:37'} ! {TIME_SPAN, 'TIME_UNIT since YYYY-MM-DD hh:mm:ss'} -!wdb fixme deleteme Switch kind to ESMF_KIND_R8 -!wdb fixme deleteme alias real kind to ESMF_KIND_R8 !wdb fixme deleteme Need to delete extra prints module MAPL_NetCDF - use, intrinsic :: iso_fortran_env, only: R64 => real64 use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod use MAPL_DateTime_Parsing, only: datetime_duration -! use MAPL_DateTime_Parsing_ESMF, only: set_ESMF_TimeInterval, set_ESMF_Time_from_ISO8601 use MAPL_DateTime_Parsing_ESMF -! use MAPL_CF_Time, only: CF_Time, convert_CF_Time_to_datetime_duration, & -! extract_ISO8601_from_CF_Time, extract_CF_Time_unit use MAPL_CF_Time -! use ESMF, only: ESMF_Time, ESMF_Time - use ESMF implicit none @@ -93,7 +85,7 @@ end subroutine get_ESMF_Time_from_NetCDF_DateTime_integer ! time0 is the start time, and time1 is time0 + interval subroutine get_ESMF_Time_from_NetCDF_DateTime_real(duration, units_string, & interval, time0, unusable, time1, tunit, rc) - real(kind=R64), intent(in) :: duration + real(kind=ESMF_KIND_R8), intent(in) :: duration character(len=*), intent(in) :: units_string type(ESMF_TimeInterval), intent(inout) :: interval type(ESMF_Time), intent(inout) :: time0 diff --git a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf index 73dd0bc49704..84032689f55e 100644 --- a/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf +++ b/base/tests/test_MAPL_DateTime_Parsing_ESMF.pf @@ -6,6 +6,7 @@ module test_MAPL_DateTime_Parsing_ESMF use MAPL_DateTime_Parsing use MAPL_DateTime_Parsing_ESMF use MAPL_CF_Time + use ESMF use, intrinsic :: iso_fortran_env, only: R64 => real64, R32 => real32 implicit none @@ -23,12 +24,7 @@ contains integer :: status call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) - @assertEqual(SUCCESS, status, 'Conversion unsuccessful') -! call set_ESMF_TimeInterval(interval, dt_dur, status) -! @assertEqual(SUCCESS, status, 'Set unsuccessful') -! call ESMF_TimeIntervalGet(interval, s = actual, rc = status) -! @assertEqual(SUCCESS, status, 'Get unsuccessful') -! @assertEqual(duration, actual, 'Incorrect interval duration') + @assertEqual(_SUCCESS, status, 'Conversion unsuccessful') end subroutine test_set_ESMF_TimeInterval_integer @@ -41,12 +37,7 @@ contains integer :: status call convert_CF_Time_to_datetime_duration(duration, units, dt_dur, rc = status) - @assertEqual(SUCCESS, status, 'Conversion unsuccessful') -! call set_ESMF_TimeInterval(interval, dt_dur, rc = status) -! @assertEqual(SUCCESS, status, 'Set unsuccessful') -! call ESMF_TimeIntervalGet(interval, s_r8 = actual, rc = status) -! @assertEqual(SUCCESS, status, 'Get unsuccessful') -! @assertEqual(duration, actual, 'Incorrect interval duration') + @assertEqual(_SUCCESS, status, 'Conversion unsuccessful') end subroutine test_set_ESMF_TimeInterval_real @@ -58,9 +49,9 @@ contains integer :: status call set_ESMF_Time_from_ISO8601(time, isostring, rc = status) - @assertTrue(status == SUCCESS, 'Failed to set ESMF_Time') + @assertTrue(status == _SUCCESS, 'Failed to set ESMF_Time') call ESMF_TimeGet(time, timeStringISOFrac = actual, rc = status) - @assertTrue(status == SUCCESS, 'Failed to get isostring') + @assertTrue(status == _SUCCESS, 'Failed to get isostring') @assertEqual(isostring, actual, 'ISO8601 strings do not match.') end subroutine test_ESMF_Time_from_ISO8601 diff --git a/base/tests/test_MAPL_NetCDF.pf b/base/tests/test_MAPL_NetCDF.pf index 91e04ee98861..fc6adb413188 100644 --- a/base/tests/test_MAPL_NetCDF.pf +++ b/base/tests/test_MAPL_NetCDF.pf @@ -148,41 +148,6 @@ contains @assertTrue(ESMF_Times_Equal(ebtime, btime), 'base ESMF_Time values do not match: ' // msg_base_time) @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match: " // msg_tunit) @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match: ' // msg_time) -! integer :: yy, mm, dd, h, m, s, m_time -! character(len=*), parameter :: UNITS = 'seconds' -! character(len=:), allocatable :: tunit, units_string -! type(ESMF_Time) :: time, etime, btime, ebtime -! type(ESMF_TimeInterval) :: time_interval -! character(len=ESMF_MAXSTR) :: expected_base_datetime_string -! character(len=ESMF_MAXSTR) :: expected_datetime_string -! character(len=ESMF_MAXSTR) :: actual_base_datetime_string -! character(len=ESMF_MAXSTR) :: actual_datetime_string -! character(len=:), allocatable :: msg_time, msg_base_time -! integer :: status -! -! yy = 1999 -! mm = 12 -! dd = 31 -! h = 23 -! m = 29 -! m_time = 59 -! s = 59 -! duration = ( m_time - m ) * SECONDS_PER_MINUTE -! units_string = UNITS // ' since 1999-12-31 23:29:59' -! -! call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m_time, s=s, rc=status) -! @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') -! -! call get_ESMF_Time_from_NetCDF_DateTime(duration, units_string, time_interval, btime, & -! time1 = time, tunit = tunit, rc = status) -! @assertTrue(status == _SUCCESS, 'Conversion failed') -! -! @assertTrue(ESMF_Times_Equal(etime, btime), 'base ESMF_Time values do not match.') -! @assertTrue(trim(tunit) == trim(UNITS), "Time units don't match.") -! -! call ESMF_TimeSet(etime, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, rc=status) -! @assertTrue(status == _SUCCESS, 'Unable to create expected ESMF_Time') -! @assertTrue(ESMF_Times_Equal(etime, time), 'ESMF_Time values do not match.') end subroutine test_convert_NetCDF_DateTime_to_ESMF_real diff --git a/shared/MAPL_CF_Time.F90 b/shared/MAPL_CF_Time.F90 index 4d72ede5811c..33581d303656 100644 --- a/shared/MAPL_CF_Time.F90 +++ b/shared/MAPL_CF_Time.F90 @@ -1,6 +1,5 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" -!wdb fixme deleteme Need to delete extra prints module MAPL_CF_Time use, intrinsic :: iso_fortran_env, only : R64 => real64 @@ -67,8 +66,6 @@ module MAPL_CF_Time logical :: is_valid character(len=:), allocatable :: time_unit character(len=:), allocatable :: base_datetime -! contains -! procedure, public, pass(this) :: check => check_cf_time end type CF_Time type, extends(CF_Time) :: CF_Time_Integer @@ -202,7 +199,6 @@ subroutine convert_CF_Time_to_datetime_duration_integer(cft, dt_duration, rc) tu = get_time_unit(cft % time_unit) if(tu == TIME_UNIT_UNKNOWN) then -! _FAIL('Unrecognized time unit in CF Time') _RETURN(_FAILURE) endif @@ -225,7 +221,6 @@ subroutine convert_CF_Time_to_datetime_duration_real(cft, dt_duration, rc) tu = get_time_unit(cft % time_unit) if(tu == TIME_UNIT_UNKNOWN) then -! _FAIL('Unrecognized time unit in CF Time') _RETURN(_FAILURE) endif @@ -265,7 +260,6 @@ function convert_CF_Time_datetime_string_to_ISO8601(datetime_string) result(isod character(len=*), intent(in) :: datetime_string character(len=MAX_CHARACTER_LENGTH) :: isodatetime character(len=MAX_CHARACTER_LENGTH) :: remainder - ! parts [year, month, day, hour, minute, second) character(len=MAX_CHARACTER_LENGTH) :: part(NUM_TIME_UNITS) character(len=MAX_CHARACTER_LENGTH) :: delimiters(NUM_TIME_UNITS) @@ -363,14 +357,6 @@ subroutine initialize_cf_time(cft, units) end subroutine initialize_cf_time -! logical function check_cf_time(this) -! class(CF_Time), intent(in) :: this -! integer :: status -! -! check_cf_time = this % is_valid -! -! end function check_cf_time - ! END CONSTRUCTORS diff --git a/shared/MAPL_DateTime_Parsing.F90 b/shared/MAPL_DateTime_Parsing.F90 index 3ef6fb33136c..d1b935dce57f 100644 --- a/shared/MAPL_DateTime_Parsing.F90 +++ b/shared/MAPL_DateTime_Parsing.F90 @@ -34,8 +34,6 @@ ! ! Fully-formed time with time zone. Local time not-supported !