diff --git a/esmf_utils/ESMF_Time_Utilities.F90 b/esmf_utils/ESMF_Time_Utilities.F90 index 8a5d6cf841b2..4264752b1bf5 100644 --- a/esmf_utils/ESMF_Time_Utilities.F90 +++ b/esmf_utils/ESMF_Time_Utilities.F90 @@ -6,8 +6,7 @@ module mapl3g_ESMF_Time_Utilities private public :: zero_time_interval - public :: intervals_are_compatible - public :: times_and_intervals_are_compatible + public :: intervals_and_offset_are_compatible interface zero_time_interval module procedure :: get_zero @@ -23,71 +22,51 @@ module mapl3g_ESMF_Time_Utilities contains - ! must be possible to compare intervals, based on their nonzero units - ! smaller interval must divide the larger interval evenly - ! assumes they have the same sign. - subroutine intervals_are_compatible(larger, smaller, compatible, rc) - type(ESMF_TimeInterval), intent(in) :: larger - type(ESMF_TimeInterval), intent(in) :: smaller - logical, intent(out) :: compatible - integer, optional, intent(out) :: rc - integer :: status - - _ASSERT(smaller /= get_zero(), 'The smaller unit must be nonzero.') - associate(abs_larger => ESMF_TimeIntervalAbsValue(larger), abs_smaller => ESMF_TimeIntervalAbsValue(smaller)) - compatible = abs_larger >= abs_smaller - _RETURN_UNLESS(compatible) - call can_compare_intervals(larger, smaller, compatible, _RC) - _RETURN_UNLESS(compatible) - compatible = mod(abs_larger, abs_smaller) == get_zero() - end associate - - _RETURN(_SUCCESS) - - end subroutine intervals_are_compatible - ! intervals must be comparable, abs(interval1) >= abs(interval2) ! abs(interval2) must evenly divide absolute difference of times - subroutine times_and_intervals_are_compatible(interval1, time1, interval2, time2, compatible, rc) - type(ESMF_Time), intent(in) :: time1 - type(ESMF_Time), intent(in) :: time2 - type(ESMF_TimeInterval), intent(in) :: interval1 + subroutine intervals_and_offset_are_compatible(interval, interval2, offset, compatible, rc) + type(ESMF_TimeInterval), intent(in) :: interval type(ESMF_TimeInterval), intent(in) :: interval2 + type(ESMF_TimeInterval), optional, intent(in) :: offset logical, intent(out) :: compatible integer, optional, intent(inout) :: rc integer :: status - type(ESMF_TimeInterval) :: absdiff - - call intervals_are_compatible(interval1, interval2, compatible, _RC) - _RETURN_UNLESS(compatible) - absdiff = ESMF_TimeIntervalAbsValue(time1 - time2) - compatible = mod(absdiff, ESMF_TimeIntervalAbsValue(interval2)) == get_zero() + type(ESMF_TimeInterval), pointer :: zero => null() + integer(kind=I4) :: units(NUM_INTERVAL_UNITS), units2(NUM_INTERVAL_UNITS) + + compatible = .FALSE. + zero => zero_time_interval() + _ASSERT(interval2 /= zero, 'The second interval must be nonzero.') + units = to_array(interval, _RC) + units2 = to_array(interval2, _RC) + _RETURN_IF(cannot_compare(units == 0, units2 == 0)) + associate(abs1 => ESMF_TimeIntervalAbsValue(interval), & + & abs2 => ESMF_TimeIntervalAbsValue(interval2)) + _RETURN_IF(abs1 < abs2 .or. mod(abs1, abs2) /= zero) + compatible = abs1 >= abs2 .and. mod(abs1, abs2) == zero + _RETURN_UNLESS(present(offset)) + compatible = compatible .and. mod(ESMF_TimeIntervalAbsValue(offset), abs2) == zero + end associate _RETURN(_SUCCESS) - end subroutine times_and_intervals_are_compatible - -! These combinations (larger, smaller): (yy and/or mm, d), (yy and/or mm, h), -! (yy and/or mm, m), and (yy and/or mm, s) do not work because the -! ESMF_TimeInterval overload of the mod function gives incorrect results for -! these combinations. Presumably ms, us, and ns for the smaller interval do -! not work. - subroutine can_compare_intervals(larger, smaller, comparable, rc) - type(ESMF_TimeInterval), intent(in) :: larger - type(ESMF_TimeInterval), intent(in) :: smaller - logical, intent(out) :: comparable - integer, optional, intent(out) :: rc - integer :: status + contains - comparable = has_only_years_and_months(larger, _RC) - comparable = comparable .and. has_only_years_and_months(smaller, _RC) - _RETURN_IF(comparable) +! These combinations (larger, smaller): (yy and/or mm, d), (yy and/or mm, h), +! (yy and/or mm, m), and (yy and/or mm, s) do not work because the +! ESMF_TimeInterval overload of the mod function gives incorrect results for +! these combinations. Presumably ms, us, and ns for the smaller interval do +! not work. - comparable = has_no_years_or_months(larger, _RC) - comparable = comparable .and. has_no_years_or_months(smaller, _RC) - _RETURN(_SUCCESS) + logical function cannot_compare(z, z2) + logical, intent(in) :: z(:), z2(:) + integer, parameter :: MONTH = 2 + + cannot_compare = any(z .neqv. z2) .or. .not. (all(z(:MONTH)) .or. all(z(MONTH+1:))) + + end function cannot_compare + + end subroutine intervals_and_offset_are_compatible - end subroutine can_compare_intervals - function get_zero() result(zero) type(ESMF_TimeInterval), pointer :: zero logical, save :: zero_is_uninitialized = .TRUE. @@ -100,9 +79,9 @@ function get_zero() result(zero) end function get_zero - subroutine as_array(interval, units, rc) + function to_array(interval, rc) result(units) + integer(kind=I4) :: units(NUM_INTERVAL_UNITS) type(ESMF_TimeInterval), intent(in) :: interval - integer(kind=I4), intent(out) :: units(NUM_INTERVAL_UNITS) integer, optional, intent(out) :: rc integer :: status @@ -110,30 +89,6 @@ subroutine as_array(interval, units, rc) & h=units(4), m=units(5), s=units(6), ms=units(7), us=units(8), ns=units(9), _RC) _RETURN(_SUCCESS) - end subroutine as_array - - logical function has_only_years_and_months(interval, rc) - type(ESMF_TimeInterval), intent(in) :: interval - integer, optional, intent(out) :: rc - integer :: status - integer(kind=I4) :: units(NUM_INTERVAL_UNITS) - - call as_array(interval, units, _RC) - has_only_years_and_months = all(units(3:) == 0) - _RETURN(_SUCCESS) - - end function has_only_years_and_months - - logical function has_no_years_or_months(interval, rc) - type(ESMF_TimeInterval), intent(in) :: interval - integer, optional, intent(out) :: rc - integer :: status - integer(kind=I4) :: units(NUM_INTERVAL_UNITS) - - call as_array(interval, units, _RC) - has_no_years_or_months = all(units(1:2) == 0) - _RETURN(_SUCCESS) - - end function has_no_years_or_months + end function to_array end module mapl3g_ESMF_Time_Utilities diff --git a/esmf_utils/tests/Test_ESMF_Time_Utilities.pf b/esmf_utils/tests/Test_ESMF_Time_Utilities.pf index 83021e21d545..19d775ad9157 100644 --- a/esmf_utils/tests/Test_ESMF_Time_Utilities.pf +++ b/esmf_utils/tests/Test_ESMF_Time_Utilities.pf @@ -22,91 +22,91 @@ contains end subroutine test_get_zero - @Test - subroutine test_intervals_are_compatible() - type(ESMF_TimeInterval) :: larger - type(ESMF_TimeInterval) :: smaller - integer(kind=ESMF_KIND_I4), parameter :: YY = 3 - integer(kind=ESMF_KIND_I4), parameter :: MM = 3 - integer(kind=ESMF_KIND_I4), parameter :: DD = 3 - integer(kind=ESMF_KIND_I4), parameter :: H = 3 - logical :: compatible - integer :: status - - call ESMF_TimeIntervalSet(larger, d=3*DD, _RC) - call ESMF_TimeIntervalSet(smaller, d=DD, _RC) - call intervals_are_compatible(larger, smaller, compatible, _RC) - @assertTrue(compatible, 'The intervals are compatible.') - - call intervals_are_compatible(smaller, larger, compatible, _RC) - @assertFalse(compatible, 'The larger unit must come first.') - - call ESMF_TimeIntervalSet(smaller, d=2*DD, _RC) - call intervals_are_compatible(larger, smaller, compatible, _RC) - @assertFalse(compatible, 'The smaller interval does not divide the larger interval evenly.') - - end subroutine test_intervals_are_compatible - - @Test - subroutine test_times_and_intervals_are_compatible() - type(ESMF_TimeInterval) :: larger - type(ESMF_TimeInterval) :: smaller - type(ESMF_Time) :: time1 - type(ESMF_Time) :: time2 - logical :: compatible - integer :: status - - call ESMF_TimeSet(time1, yy=1582, mm=10, dd=16, h=7, _RC) - call ESMF_TimeSet(time2, yy=1582, mm=10, dd=15, h=19, _RC) - call ESMF_TimeIntervalSet(larger, d=1, _RC) - call ESMF_TimeIntervalSet(smaller, h = 6, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertTrue(compatible, 'The times and intervals are compatible.') - - call ESMF_TimeSet(time2, yy=1582, mm=10, dd=15, h=18, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'The time difference is not evenly divisible by the smaller interval.') - - call ESMF_TimeSet(time1, yy=1582, mm=10, dd=16, h=18, _RC) - call ESMF_TimeIntervalSet(larger, h=6, _RC) - call ESMF_TimeIntervalSet(smaller, h=4, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'The larger interval is not evenly divisible by the smaller interval.') - - call ESMF_TimeIntervalSet(larger, mm=1, _RC) - call ESMF_TimeIntervalSet(smaller, d=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'Larger interval cannot include months.') - - call ESMF_TimeIntervalSet(larger, d=90, _RC) - call ESMF_TimeIntervalSet(smaller, mm=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'Smaller interval cannot include months.') - - call ESMF_TimeIntervalSet(larger, yy=1, _RC) - call ESMF_TimeIntervalSet(smaller, d=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'Larger interval cannot include years.') - - call ESMF_TimeIntervalSet(larger, d=365, _RC) - call ESMF_TimeIntervalSet(smaller, yy=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertFalse(compatible, 'Smaller interval cannot include years.') - - call ESMF_TimeSet(time1, yy=1582, mm=10, _RC) - call ESMF_TimeSet(time2, yy=1583, mm=10, _RC) - call ESMF_TimeIntervalSet(larger, yy=3, _RC) - call ESMF_TimeIntervalSet(smaller, yy=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertTrue(compatible, 'The intervals are compatible.') - - call ESMF_TimeSet(time1, yy=1582, mm=10, _RC) - call ESMF_TimeSet(time2, yy=1583, mm=10, _RC) - call ESMF_TimeIntervalSet(larger, mm=3, _RC) - call ESMF_TimeIntervalSet(smaller, mm=1, _RC) - call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) - @assertTrue(compatible, 'The intervals are compatible.') - - end subroutine test_times_and_intervals_are_compatible +! @Test +! subroutine test_intervals_are_compatible() +! type(ESMF_TimeInterval) :: larger +! type(ESMF_TimeInterval) :: smaller +! integer(kind=ESMF_KIND_I4), parameter :: YY = 3 +! integer(kind=ESMF_KIND_I4), parameter :: MM = 3 +! integer(kind=ESMF_KIND_I4), parameter :: DD = 3 +! integer(kind=ESMF_KIND_I4), parameter :: H = 3 +! logical :: compatible +! integer :: status +! +! call ESMF_TimeIntervalSet(larger, d=3*DD, _RC) +! call ESMF_TimeIntervalSet(smaller, d=DD, _RC) +! call intervals_are_compatible(larger, smaller, compatible, _RC) +! @assertTrue(compatible, 'The intervals are compatible.') +! +! call intervals_are_compatible(smaller, larger, compatible, _RC) +! @assertFalse(compatible, 'The larger unit must come first.') +! +! call ESMF_TimeIntervalSet(smaller, d=2*DD, _RC) +! call intervals_are_compatible(larger, smaller, compatible, _RC) +! @assertFalse(compatible, 'The smaller interval does not divide the larger interval evenly.') +! +! end subroutine test_intervals_are_compatible + +! @Test +! subroutine test_times_and_intervals_are_compatible() +! type(ESMF_TimeInterval) :: larger +! type(ESMF_TimeInterval) :: smaller +! type(ESMF_Time) :: time1 +! type(ESMF_Time) :: time2 +! logical :: compatible +! integer :: status +! +! call ESMF_TimeSet(time1, yy=1582, mm=10, dd=16, h=7, _RC) +! call ESMF_TimeSet(time2, yy=1582, mm=10, dd=15, h=19, _RC) +! call ESMF_TimeIntervalSet(larger, d=1, _RC) +! call ESMF_TimeIntervalSet(smaller, h = 6, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertTrue(compatible, 'The times and intervals are compatible.') +! +! call ESMF_TimeSet(time2, yy=1582, mm=10, dd=15, h=18, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'The time difference is not evenly divisible by the smaller interval.') +! +! call ESMF_TimeSet(time1, yy=1582, mm=10, dd=16, h=18, _RC) +! call ESMF_TimeIntervalSet(larger, h=6, _RC) +! call ESMF_TimeIntervalSet(smaller, h=4, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'The larger interval is not evenly divisible by the smaller interval.') +! +! call ESMF_TimeIntervalSet(larger, mm=1, _RC) +! call ESMF_TimeIntervalSet(smaller, d=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'Larger interval cannot include months.') +! +! call ESMF_TimeIntervalSet(larger, d=90, _RC) +! call ESMF_TimeIntervalSet(smaller, mm=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'Smaller interval cannot include months.') +! +! call ESMF_TimeIntervalSet(larger, yy=1, _RC) +! call ESMF_TimeIntervalSet(smaller, d=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'Larger interval cannot include years.') +! +! call ESMF_TimeIntervalSet(larger, d=365, _RC) +! call ESMF_TimeIntervalSet(smaller, yy=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertFalse(compatible, 'Smaller interval cannot include years.') +! +! call ESMF_TimeSet(time1, yy=1582, mm=10, _RC) +! call ESMF_TimeSet(time2, yy=1583, mm=10, _RC) +! call ESMF_TimeIntervalSet(larger, yy=3, _RC) +! call ESMF_TimeIntervalSet(smaller, yy=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertTrue(compatible, 'The intervals are compatible.') +! +! call ESMF_TimeSet(time1, yy=1582, mm=10, _RC) +! call ESMF_TimeSet(time2, yy=1583, mm=10, _RC) +! call ESMF_TimeIntervalSet(larger, mm=3, _RC) +! call ESMF_TimeIntervalSet(smaller, mm=1, _RC) +! call times_and_intervals_are_compatible(larger, time1, smaller, time2, compatible, _RC) +! @assertTrue(compatible, 'The intervals are compatible.') +! +! end subroutine test_times_and_intervals_are_compatible end module Test_ESMF_Time_Utilities diff --git a/generic3g/ComponentSpecParser.F90 b/generic3g/ComponentSpecParser.F90 index f656c132c2ce..60b67223fba3 100644 --- a/generic3g/ComponentSpecParser.F90 +++ b/generic3g/ComponentSpecParser.F90 @@ -64,17 +64,17 @@ module mapl3g_ComponentSpecParser character(*), parameter :: KEY_VERTICAL_DIM_SPEC = 'vertical_dim_spec' character(*), parameter :: KEY_ACCUMULATION_TYPE = 'accumulation_type' character(*), parameter :: KEY_TIMESTEP = 'timestep' - character(*), parameter :: KEY_REFERENCE_TIME = 'reference_time' + character(*), parameter :: KEY_REFERENCE_TIME_OFFSET = 'reference_time_offset' !> ! Submodule declarations INTERFACE - module function parse_component_spec(hconfig, registry, timeStep, refTime, rc) result(spec) + module function parse_component_spec(hconfig, registry, timeStep, refTime_offset, rc) result(spec) type(ComponentSpec) :: spec type(ESMF_HConfig), target, intent(inout) :: hconfig type(StateRegistry), target, intent(in) :: registry type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc end function parse_component_spec @@ -85,11 +85,11 @@ module function parse_geometry_spec(mapl_cfg, registry, rc) result(geometry_spec integer, optional, intent(out) :: rc end function parse_geometry_spec - module function parse_var_specs(hconfig, timeStep, refTime, rc) result(var_specs) + module function parse_var_specs(hconfig, timeStep, refTime_offset, rc) result(var_specs) type(VariableSpecVector) :: var_specs type(ESMF_HConfig), intent(in) :: hconfig type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc end function parse_var_specs @@ -117,10 +117,10 @@ module function parse_child(hconfig, rc) result(child) integer, optional, intent(out) :: rc end function parse_child - module subroutine parse_timespec(hconfig, timeStep, refTime, rc) + module subroutine parse_timespec(hconfig, timeStep, refTime_offset, rc) type(ESMF_HConfig), intent(in) :: hconfig type(ESMF_TimeInterval), allocatable, intent(out) :: timeStep - type(ESMF_Time), allocatable, intent(out) :: refTime + type(ESMF_TimeInterval), allocatable, intent(out) :: refTime_offset integer, optional, intent(out) :: rc end subroutine parse_timespec diff --git a/generic3g/ComponentSpecParser/parse_child.F90 b/generic3g/ComponentSpecParser/parse_child.F90 index 3e61d56aa066..a436f1b4c6fd 100644 --- a/generic3g/ComponentSpecParser/parse_child.F90 +++ b/generic3g/ComponentSpecParser/parse_child.F90 @@ -22,8 +22,8 @@ module function parse_child(hconfig, rc) result(child) logical :: has_config_file type(ESMF_HConfig), allocatable :: child_hconfig character(:), allocatable :: sharedObj, userProcedure, config_file - type(ESMF_Time), allocatable :: refTime - type(ESMF_TimeInterval), allocatable :: timeSTep + type(ESMF_TimeInterval), allocatable :: refTime_offset + type(ESMF_TimeInterval), allocatable :: timeStep dso_found = .false. ! Ensure precisely one name is used for dso @@ -61,9 +61,9 @@ module function parse_child(hconfig, rc) result(child) setservices = user_setservices(sharedObj, userProcedure) - call parse_timespec(hconfig, timeStep, refTime, _RC) + call parse_timespec(hconfig, timeStep, refTime_offset, _RC) - child = ChildSpec(setservices, hconfig=child_hconfig, timeStep=timeStep, refTime=refTime) + child = ChildSpec(setservices, hconfig=child_hconfig, timeStep=timeStep, refTime_offset=refTime_offset) _RETURN(_SUCCESS) diff --git a/generic3g/ComponentSpecParser/parse_component_spec.F90 b/generic3g/ComponentSpecParser/parse_component_spec.F90 index c30dc03e946b..46c3b40cc3be 100644 --- a/generic3g/ComponentSpecParser/parse_component_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_component_spec.F90 @@ -5,12 +5,12 @@ contains - module function parse_component_spec(hconfig, registry, timeStep, refTime, rc) result(spec) + module function parse_component_spec(hconfig, registry, timeStep, refTime_offset, rc) result(spec) type(ComponentSpec) :: spec type(ESMF_HConfig), target, intent(inout) :: hconfig type(StateRegistry), target, intent(in) :: registry type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc integer :: status @@ -22,7 +22,7 @@ module function parse_component_spec(hconfig, registry, timeStep, refTime, rc) r mapl_cfg = ESMF_HConfigCreateAt(hconfig, keyString=MAPL_SECTION, _RC) spec%geometry_spec = parse_geometry_spec(mapl_cfg, registry, _RC) - spec%var_specs = parse_var_specs(mapl_cfg, timeStep, refTime, _RC) + spec%var_specs = parse_var_specs(mapl_cfg, timeStep, refTime_offset, _RC) spec%connections = parse_connections(mapl_cfg, _RC) spec%children = parse_children(mapl_cfg, _RC) diff --git a/generic3g/ComponentSpecParser/parse_timespec.F90 b/generic3g/ComponentSpecParser/parse_timespec.F90 index a6c3083e3bbb..bb3a62b3efe6 100644 --- a/generic3g/ComponentSpecParser/parse_timespec.F90 +++ b/generic3g/ComponentSpecParser/parse_timespec.F90 @@ -5,16 +5,16 @@ contains - module subroutine parse_timespec(hconfig, timestep, refTime, rc) + module subroutine parse_timespec(hconfig, timestep, refTime_offset, rc) type(ESMF_HConfig), intent(in) :: hconfig type(ESMF_TimeInterval), allocatable, intent(out) :: timeStep - type(ESMF_Time), allocatable, intent(out) :: refTime + type(ESMF_TimeInterval), allocatable, intent(out) :: refTime_offset integer, optional, intent(out) :: rc integer :: status call parse_timeStep(hconfig, timeStep, _RC) - call parse_refTime(hconfig, refTime, _RC) + call parse_refTime_offset(hconfig, refTime_offset, _RC) _RETURN(_SUCCESS) @@ -40,25 +40,25 @@ subroutine parse_timestep(hconfig, timeStep, rc) _RETURN(_SUCCESS) end subroutine parse_timestep - subroutine parse_refTime(hconfig, refTime, rc) + subroutine parse_refTime_offset(hconfig, refTime_offset, rc) type(ESMF_HConfig), intent(in) :: hconfig - type(ESMF_Time), allocatable, intent(out) :: refTime + type(ESMF_TimeInterval), allocatable, intent(out) :: refTime_offset integer, optional, intent(out) :: rc integer :: status - logical :: has_refTime - character(len=32) :: iso_datetime - type(ESMF_Time) :: time + logical :: has_refTime_offset + character(len=32) :: iso_duration + type(ESMF_TimeInterval) :: duration - has_refTime = ESMF_HConfigIsDefined(hconfig, keyString=KEY_REFERENCE_TIME, _RC) - _RETURN_UNLESS(has_refTime) + has_refTime_offset = ESMF_HConfigIsDefined(hconfig, keyString=KEY_REFERENCE_TIME_OFFSET, _RC) + _RETURN_UNLESS(has_refTime_offset) - iso_datetime = ESMF_HConfigAsString(hconfig, keyString=KEY_REFERENCE_TIME, _RC) - call ESMF_TimeSet(time, timeString=iso_datetime, _RC) - refTime = time + iso_duration = ESMF_HConfigAsString(hconfig, keyString=KEY_REFERENCE_TIME_OFFSET, _RC) + call ESMF_TimeIntervalSet(duration, timeIntervalString=iso_duration, _RC) + refTime_offset = duration _RETURN(_SUCCESS) - end subroutine parse_refTime + end subroutine parse_refTime_offset end submodule parse_timespec_smod diff --git a/generic3g/ComponentSpecParser/parse_var_specs.F90 b/generic3g/ComponentSpecParser/parse_var_specs.F90 index 6dc50d2de77e..6243252c9dcf 100644 --- a/generic3g/ComponentSpecParser/parse_var_specs.F90 +++ b/generic3g/ComponentSpecParser/parse_var_specs.F90 @@ -8,11 +8,11 @@ ! A component is not required to have var_specs. E.g, in theory GCM gridcomp will not ! have var specs in MAPL3, as it does not really have a preferred geom on which to declare ! imports and exports. - module function parse_var_specs(hconfig, timestep, refTime, rc) result(var_specs) + module function parse_var_specs(hconfig, timestep, refTime_offset, rc) result(var_specs) type(VariableSpecVector) :: var_specs type(ESMF_HConfig), intent(in) :: hconfig type(ESMF_TimeInterval), optional, intent(in) :: timestep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc integer :: status @@ -24,21 +24,21 @@ module function parse_var_specs(hconfig, timestep, refTime, rc) result(var_specs subcfg = ESMF_HConfigCreateAt(hconfig,keyString=COMPONENT_STATES_SECTION, _RC) - call parse_state_specs(var_specs, subcfg, COMPONENT_INTERNAL_STATE_SECTION, timestep, refTime, _RC) - call parse_state_specs(var_specs, subcfg, COMPONENT_EXPORT_STATE_SECTION, timestep, refTime, _RC) - call parse_state_specs(var_specs, subcfg, COMPONENT_IMPORT_STATE_SECTION, timestep, refTime, _RC) + call parse_state_specs(var_specs, subcfg, COMPONENT_INTERNAL_STATE_SECTION, timestep, refTime_offset, _RC) + call parse_state_specs(var_specs, subcfg, COMPONENT_EXPORT_STATE_SECTION, timestep, refTime_offset, _RC) + call parse_state_specs(var_specs, subcfg, COMPONENT_IMPORT_STATE_SECTION, timestep, refTime_offset, _RC) call ESMF_HConfigDestroy(subcfg, _RC) _RETURN(_SUCCESS) contains - subroutine parse_state_specs(var_specs, hconfig, state_intent, timestep, refTime, rc) + subroutine parse_state_specs(var_specs, hconfig, state_intent, timestep, refTime_offset, rc) type(VariableSpecVector), intent(inout) :: var_specs type(ESMF_HConfig), target, intent(in) :: hconfig character(*), intent(in) :: state_intent type(ESMF_TimeInterval), optional, intent(in) :: timestep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc type(VariableSpec) :: var_spec @@ -116,7 +116,7 @@ subroutine parse_state_specs(var_specs, hconfig, state_intent, timestep, refTime dependencies=dependencies, & accumulation_type=accumulation_type, & timestep=timestep, & - refTime=refTime, _RC) + refTime_offset=refTime_offset, _RC) if (allocated(units)) deallocate(units) if (allocated(standard_name)) deallocate(standard_name) diff --git a/generic3g/MAPL_Generic.F90 b/generic3g/MAPL_Generic.F90 index ab35f006549e..6601d841dc17 100644 --- a/generic3g/MAPL_Generic.F90 +++ b/generic3g/MAPL_Generic.F90 @@ -274,7 +274,7 @@ subroutine gridcomp_set(gridcomp, unusable, activate_all_exports, activate_all_i _UNUSED_DUMMY(unusable) end subroutine gridcomp_set - subroutine gridcomp_add_child_config(gridcomp, child_name, setservices, hconfig, unusable, timeStep, refTime, rc) + subroutine gridcomp_add_child_config(gridcomp, child_name, setservices, hconfig, unusable, timeStep, refTime_offset, rc) use mapl3g_UserSetServices type(ESMF_GridComp), intent(inout) :: gridcomp character(len=*), intent(in) :: child_name @@ -282,7 +282,7 @@ subroutine gridcomp_add_child_config(gridcomp, child_name, setservices, hconfig, type(ESMF_HConfig), intent(in) :: hconfig class(KeywordEnforcer), optional, intent(out) :: unusable type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc integer :: status @@ -290,7 +290,7 @@ subroutine gridcomp_add_child_config(gridcomp, child_name, setservices, hconfig, _ASSERT(is_valid_name(child_name), 'Child name <' // child_name //'> does not conform to GEOS standards.') - child_spec = ChildSpec(setServices, hconfig=hconfig, timeStep=timeStep, refTime=refTime) + child_spec = ChildSpec(setServices, hconfig=hconfig, timeStep=timeStep, refTime_offset=refTime_offset) call MAPL_GridCompAddChild(gridcomp, child_name, child_spec, _RC) _RETURN(_SUCCESS) diff --git a/generic3g/OuterMetaComponent.F90 b/generic3g/OuterMetaComponent.F90 index 1ded089154da..849591a67118 100644 --- a/generic3g/OuterMetaComponent.F90 +++ b/generic3g/OuterMetaComponent.F90 @@ -34,7 +34,7 @@ module mapl3g_OuterMetaComponent class(AbstractUserSetServices), allocatable :: user_setservices type(ESMF_TimeInterval), allocatable :: user_timeStep ! These are only allocated when parent overrides default timestepping. - type(ESMF_Time), allocatable :: user_refTime + type(ESMF_TimeInterval), allocatable :: user_refTime_offset type(MethodPhasesMap) :: user_phases_map type(ESMF_HConfig) :: hconfig diff --git a/generic3g/OuterMetaComponent/SetServices.F90 b/generic3g/OuterMetaComponent/SetServices.F90 index 7fc70989a0a9..bb0c7700c42c 100644 --- a/generic3g/OuterMetaComponent/SetServices.F90 +++ b/generic3g/OuterMetaComponent/SetServices.F90 @@ -33,8 +33,8 @@ recursive module subroutine SetServices_(this, rc) integer :: status type(ESMF_GridComp) :: user_gridcomp - ! Note that Parent component should set timestep and refTime in outer meta before calling SetServices. - this%component_spec = parse_component_spec(this%hconfig, this%registry, this%user_timeStep, this%user_refTime, _RC) + ! Note that Parent component should set timestep and refTime_offset in outer meta before calling SetServices. + this%component_spec = parse_component_spec(this%hconfig, this%registry, this%user_timeStep, this%user_refTime_offset, _RC) user_gridcomp = this%user_gc_driver%get_gridcomp() call attach_inner_meta(user_gridcomp, this%self_gridcomp, _RC) diff --git a/generic3g/OuterMetaComponent/add_child_by_spec.F90 b/generic3g/OuterMetaComponent/add_child_by_spec.F90 index 4f99f5e3d70c..7c62a8bd2e5e 100644 --- a/generic3g/OuterMetaComponent/add_child_by_spec.F90 +++ b/generic3g/OuterMetaComponent/add_child_by_spec.F90 @@ -40,8 +40,8 @@ module recursive subroutine add_child_by_spec(this, child_name, child_spec, rc) child_meta%user_timeStep = child_spec%timeStep end if - if (allocated(child_spec%refTime)) then - child_meta%user_refTime = child_spec%refTime + if (allocated(child_spec%refTime_offset)) then + child_meta%user_refTime_offset = child_spec%refTime_offset end if child_driver = GriddedComponentDriver(child_outer_gc) diff --git a/generic3g/OuterMetaComponent/initialize_set_clock.F90 b/generic3g/OuterMetaComponent/initialize_set_clock.F90 index fd39753c336a..e1081ecfef21 100644 --- a/generic3g/OuterMetaComponent/initialize_set_clock.F90 +++ b/generic3g/OuterMetaComponent/initialize_set_clock.F90 @@ -27,19 +27,24 @@ module recursive subroutine initialize_set_clock(this, outer_clock, unusable, rc type(ESMF_Clock) :: user_clock type(ESMF_Time) :: user_refTime, default_refTime type(ESMF_TimeInterval) :: user_timeStep, default_timeStep + type(ESMF_TimeInterval), allocatable :: user_offset logical :: compatible + if(allocated(user_offset)) deallocate(user_offset) call ESMF_ClockGet(outer_clock, timeStep=default_timeStep, refTime=default_refTime, _RC) user_timeStep = default_timeStep if (allocated(this%user_timeStep)) user_timeStep = this%user_timeStep user_refTime = default_refTime - if (allocated(this%user_refTime)) user_refTime = this%user_refTime - - call times_and_intervals_are_compatible(user_timestep, user_refTime, default_timestep, default_refTime, compatible, _RC) - _ASSERT(compatible, 'The user timestep and refTime are not compatible with the outer timestep and refTime') + if (allocated(this%user_refTime_offset)) then + user_offset = this%user_refTime_offset + user_refTime = user_refTime + user_offset + end if + + call intervals_and_offset_are_compatible(user_timestep, default_timestep, user_offset, compatible, _RC) + _ASSERT(compatible, 'The user timestep and refTime_offset are not compatible with the outer timestep.') user_clock = ESMF_ClockCreate(outer_clock, _RC) call ESMF_ClockSet(user_clock, timestep=user_timeStep, reftime=user_refTime, _RC) diff --git a/generic3g/specs/ChildSpec.F90 b/generic3g/specs/ChildSpec.F90 index 042a2bfe110f..1a5327ac02fe 100644 --- a/generic3g/specs/ChildSpec.F90 +++ b/generic3g/specs/ChildSpec.F90 @@ -17,7 +17,7 @@ module mapl3g_ChildSpec class(AbstractUserSetServices), allocatable :: user_setservices type(ESMF_HConfig) :: hconfig type(ESMF_TimeInterval), allocatable :: timeStep - type(ESMF_Time), allocatable :: refTime + type(ESMF_TimeInterval), allocatable :: refTime_offset contains procedure :: write_formatted generic :: write(formatted) => write_formatted @@ -38,13 +38,13 @@ module mapl3g_ChildSpec contains - function new_ChildSpec(user_setservices, unusable, hconfig, timeStep, refTime) result(spec) + function new_ChildSpec(user_setservices, unusable, hconfig, timeStep, refTime_offset) result(spec) type(ChildSpec) :: spec class(AbstractUserSetServices), intent(in) :: user_setservices class(KeywordEnforcer), optional, intent(in) :: unusable type(ESMF_HConfig), optional, intent(in) :: hconfig type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset spec%user_setservices = user_setservices if (present(hconfig)) then @@ -54,7 +54,7 @@ function new_ChildSpec(user_setservices, unusable, hconfig, timeStep, refTime) r end if if (present(timeStep)) spec%timeStep = timeStep - if (present(refTime)) spec%refTime = refTime + if (present(refTime_offset)) spec%refTime_offset = refTime_offset _UNUSED_DUMMY(unusable) end function new_ChildSpec @@ -73,7 +73,7 @@ logical function equal(a, b) equal = equal_timestep(a%timeStep, b%timestep) if (.not. equal) return - equal = equal_refTime(a%refTime, b%refTime) + equal = equal_refTime_offset(a%refTime_offset, b%refTime_offset) if (.not. equal) return contains @@ -100,16 +100,16 @@ logical function equal_timestep(a, b) result(equal) end function equal_timestep - logical function equal_refTime(a, b) result(equal) - type(ESMF_Time), allocatable, intent(in) :: a - type(ESMF_Time), allocatable, intent(in) :: b + logical function equal_refTime_offset(a, b) result(equal) + type(ESMF_TimeInterval), allocatable, intent(in) :: a + type(ESMF_TimeInterval), allocatable, intent(in) :: b equal = (allocated(a) .eqv. allocated(b)) if (.not. equal) return if (allocated(a)) equal = (a == b) - end function equal_refTime + end function equal_refTime_offset end function equal diff --git a/generic3g/specs/FrequencyAspect.F90 b/generic3g/specs/FrequencyAspect.F90 index c4ab2c331f30..7959522ee178 100644 --- a/generic3g/specs/FrequencyAspect.F90 +++ b/generic3g/specs/FrequencyAspect.F90 @@ -5,7 +5,7 @@ module mapl3g_FrequencyAspect use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_AccumulatorActionInterface - use mapl3g_ESMF_Time_Utilities, only: times_and_intervals_are_compatible, zero_time_interval + use mapl3g_ESMF_Time_Utilities, only: intervals_and_offset_are_compatible, zero_time_interval use esmf implicit none private @@ -14,9 +14,9 @@ module mapl3g_FrequencyAspect type, extends(StateItemAspect) :: FrequencyAspect private - type(ESMF_TimeInterval) :: timestep_ - type(ESMF_Time) :: refTime_ - character(len=:), allocatable :: accumulation_type_ + type(ESMF_TimeInterval) :: timestep + type(ESMF_TimeInterval) :: refTime_offset + character(len=:), allocatable :: accumulation_type contains ! These are implementations of extended derived type. procedure :: matches @@ -27,12 +27,8 @@ module mapl3g_FrequencyAspect procedure, nopass :: get_aspect_id ! These are specific to FrequencyAspect. procedure :: get_timestep - procedure :: set_timestep procedure :: get_accumulation_type - procedure :: set_accumulation_type - procedure :: get_reference_time - procedure :: set_reference_time - procedure, private :: zero_timestep + procedure :: get_reference_time_offset end type FrequencyAspect interface FrequencyAspect @@ -41,19 +37,21 @@ module mapl3g_FrequencyAspect contains - function new_FrequencyAspect(timeStep, refTime, accumulation_type) result(aspect) + function new_FrequencyAspect(timeStep, refTime_offset, accumulation_type) result(aspect) type(FrequencyAspect) :: aspect type(ESMF_TimeInterval), optional, intent(in) :: timeStep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset character(len=*), optional, intent(in) :: accumulation_type + integer :: status call aspect%set_mirror(.FALSE.) call aspect%set_time_dependent(.FALSE.) - call aspect%set_accumulation_type(INSTANTANEOUS) - call aspect%zero_timestep() - if(present(timeStep)) aspect%timestep_ = timeStep - if(present(refTime)) aspect%refTime_ = refTime - if(present(accumulation_type)) call aspect%set_accumulation_type(accumulation_type) + call set_accumulation_type(aspect, INSTANTANEOUS) + call zero_timestep(aspect, rc=status) + call zero_interval(aspect%refTime_offset, rc=status) + if(present(timeStep)) aspect%timestep = timeStep + if(present(refTime_offset)) aspect%refTime_offset = refTime_offset + if(present(accumulation_type)) call set_accumulation_type(aspect, accumulation_type) end function new_FrequencyAspect @@ -61,56 +59,50 @@ function get_timestep(this) result(ts) type(ESMF_TimeInterval) :: ts class(FrequencyAspect), intent(in) :: this - ts = this%timestep_ + ts = this%timestep end function get_timestep - subroutine set_timestep(this, timeStep) - class(FrequencyAspect), intent(inout) :: this - type(ESMF_TimeInterval), intent(in) :: timeStep - - this%timestep_ = timeStep - - end subroutine set_timestep - - function get_reference_time(this) result(time) - type(ESMF_Time) :: time + function get_reference_time_offset(this) result(off) + type(ESMF_TimeInterval) :: off class(FrequencyAspect), intent(in) :: this - time = this%refTime_ + off = this%refTime_offset - end function get_reference_time + end function get_reference_time_offset - subroutine set_reference_time(this, time) - class(FrequencyAspect), intent(inout) :: this - type(ESMF_Time), intent(in) :: time + subroutine zero_timestep(aspect, rc) + class(FrequencyAspect), intent(inout) :: aspect + integer, intent(out) :: rc - this%refTime_ = time + call zero_interval(aspect%timestep, rc=rc) - end subroutine set_reference_time + end subroutine zero_timestep - subroutine zero_timestep(this) - class(FrequencyAspect), intent(inout) :: this + subroutine zero_interval(interval, rc) + type(ESMF_TimeInterval), intent(inout) :: interval + integer, intent(out) :: rc + integer :: status - call ESMF_TimeIntervalSet(this%timestep_, ns=0) + call ESMF_TimeIntervalSet(interval, ns=0, rc=rc) - end subroutine zero_timestep + end subroutine zero_interval function get_accumulation_type(this) result(at) character(len=:), allocatable :: at class(FrequencyAspect), intent(in) :: this at = '' - if(allocated(this%accumulation_type_)) at = this%accumulation_type_ + if(allocated(this%accumulation_type)) at = this%accumulation_type end function get_accumulation_type - subroutine set_accumulation_type(this, accumulation_type) - class(FrequencyAspect), intent(inout) :: this + subroutine set_accumulation_type(aspect, accumulation_type) + class(FrequencyAspect), intent(inout) :: aspect character(len=*), intent(in) :: accumulation_type if(accumulation_type == INSTANTANEOUS .or. accumulation_type_is_valid(accumulation_type)) then - this%accumulation_type_ = accumulation_type + aspect%accumulation_type = accumulation_type end if end subroutine set_accumulation_type @@ -185,9 +177,8 @@ logical function supports_conversion_specific(src, dst) result(supports) select type(dst) class is (FrequencyAspect) - call times_and_intervals_are_compatible(& - & src%get_timestep(), src%get_reference_time(),& - & dst%get_timestep(), dst%get_reference_time(),& + call intervals_and_offset_are_compatible(src%get_timestep(), & + & dst%get_timestep(), src%get_reference_time_offset(), & & supports, rc=status) supports = supports .and. status == _SUCCESS end select diff --git a/generic3g/specs/VariableSpec.F90 b/generic3g/specs/VariableSpec.F90 index c3268165a548..971ddcd30d25 100644 --- a/generic3g/specs/VariableSpec.F90 +++ b/generic3g/specs/VariableSpec.F90 @@ -78,7 +78,7 @@ function make_VariableSpec( & horizontal_dims_spec, & accumulation_type, & timeStep, & - refTime, & + refTime_offset, & rc) result(var_spec) type(VariableSpec) :: var_spec @@ -102,7 +102,7 @@ function make_VariableSpec( & type(HorizontalDimsSpec), optional, intent(in) :: horizontal_dims_spec character(len=*), optional, intent(in) :: accumulation_type type(ESMF_TimeInterval), optional, intent(in) :: timestep - type(ESMF_Time), optional, intent(in) :: refTime + type(ESMF_TimeInterval), optional, intent(in) :: refTime_offset integer, optional, intent(out) :: rc type(ESMF_RegridMethod_Flag), allocatable :: regrid_method @@ -128,7 +128,8 @@ function make_VariableSpec( & call var_spec%aspects%insert(UNGRIDDED_DIMS_ASPECT_ID, UngriddedDimsAspect(ungridded_dims)) call var_spec%aspects%insert(ATTRIBUTES_ASPECT_ID, AttributesAspect(attributes)) call var_spec%aspects%insert(TYPEKIND_ASPECT_ID, TypekindAspect(typekind)) - call var_spec%aspects%insert(FREQUENCY_ASPECT_ID, FrequencyAspect(timestep=timestep, refTime=refTime, accumulation_type=accumulation_type)) + call var_spec%aspects%insert(FREQUENCY_ASPECT_ID, FrequencyAspect(timestep=timestep, & + & refTime_offset=refTime_offset, accumulation_type=accumulation_type)) _SET_OPTIONAL(standard_name) _SET_OPTIONAL(itemtype) diff --git a/generic3g/tests/Test_Aspects.pf b/generic3g/tests/Test_Aspects.pf index 7477eb4d5397..686f99c71f4d 100644 --- a/generic3g/tests/Test_Aspects.pf +++ b/generic3g/tests/Test_Aspects.pf @@ -273,8 +273,8 @@ contains call ESMF_TimeIntervalSet(dt1, s=2) call ESMF_TimeIntervalSet(dt2, s=3) ! not commensurate - import = FrequencyAspect(dt1) ! instantaneous - export = FrequencyAspect(dt2) + import = FrequencyAspect(timeStep=dt1) ! instantaneous + export = FrequencyAspect(timeStep=dt2) @assert_that(export%can_connect_to(import), is(true())) @@ -285,15 +285,15 @@ contains type(FrequencyAspect) :: import, export type(ESMF_TimeInterval) :: dt1, dt2 - type(ESMF_Time) :: time1, time2 + type(ESMF_TimeInterval) :: offset1, offset2 call ESMF_TimeIntervalSet(dt1, s=4) call ESMF_TimeIntervalSet(dt2, s=2) ! commensurate - call ESMF_TimeSet(time1, s=0) - call ESMF_TimeSet(time2, s=0) + call ESMF_TimeIntervalSet(offset1, s=0) + call ESMF_TimeIntervalSet(offset2, s=0) - import = FrequencyAspect(dt2, time2, accumulation_type='mean') - export = FrequencyAspect(dt1, time1) + import = FrequencyAspect(timeStep=dt2, refTime_offset=offset2, accumulation_type='mean') + export = FrequencyAspect(timeStep=dt1, refTime_offset=offset1) @assert_that(export%can_connect_to(import), is(true())) end subroutine test_can_connect_accum_mean @@ -304,15 +304,15 @@ contains type(FrequencyAspect) :: import, export type(ESMF_TimeInterval) :: dt1, dt2 - type(ESMF_Time) :: time1, time2 + type(ESMF_TimeInterval) :: offset1, offset2 call ESMF_TimeIntervalSet(dt1, s=4) call ESMF_TimeIntervalSet(dt2, s=3) ! not commensurate - call ESMF_TimeSet(time1, s=0) - call ESMF_TimeSet(time2, s=0) + call ESMF_TimeIntervalSet(offset1, s=0) + call ESMF_TimeIntervalSet(offset2, s=0) - import = FrequencyAspect(dt2, time2, accumulation_type='mean') - export = FrequencyAspect(dt1, time1) + import = FrequencyAspect(timeStep=dt2, refTime_offset=offset2, accumulation_type='mean') + export = FrequencyAspect(timeStep=dt1, refTime_offset=offset1) @assert_that(export%can_connect_to(import), is(false())) end subroutine test_can_connect_accum_fail diff --git a/generic3g/tests/Test_ComponentSpecParser.pf b/generic3g/tests/Test_ComponentSpecParser.pf index 891ca94fcaed..be877e61582b 100644 --- a/generic3g/tests/Test_ComponentSpecParser.pf +++ b/generic3g/tests/Test_ComponentSpecParser.pf @@ -202,15 +202,15 @@ contains @test subroutine test_parse_timespec() - type(ESMF_TimeInterval) :: expected_interval - type(ESMF_Time) :: expected_time + type(ESMF_TimeInterval) :: expected_duration + type(ESMF_TimeInterval) :: expected_offset character(len=*), parameter :: ISO_DURATION = 'P3M' - character(len=*), parameter :: ISO_TIME = '1582-10-15' + character(len=*), parameter :: ISO_OFFSET = 'P1D' character(len=*), parameter :: NL = new_line('10') character(len=:), allocatable :: content type(ESMF_HConfig) :: hconfig - type(ESMF_TimeInterval), allocatable :: actual_interval - type(ESMF_Time), allocatable :: actual_time + type(ESMF_TimeInterval), allocatable :: actual_duration + type(ESMF_TimeInterval), allocatable :: actual_offset integer :: actual_mm integer :: expected_mm integer :: actual_time_array(3) @@ -218,26 +218,25 @@ contains integer :: rc, status ! Test with correct key for timestep - call ESMF_TimeIntervalSet(expected_interval, mm=3, _RC) - call ESMF_TimeSet(expected_time, yy=1582, mm=10, dd=15, _RC) - content = 'timestep: ' // ISO_DURATION // NL // 'reference_time: ' // ISO_TIME + call ESMF_TimeIntervalSet(expected_duration, mm=3, _RC) + call ESMF_TimeIntervalSet(expected_offset, d=1, _RC) + content = 'timestep: ' // ISO_DURATION // NL // 'reference_time_offset: ' // ISO_OFFSET hconfig = ESMF_HConfigCreate(content=content, _RC) - call parse_timespec(hconfig, actual_interval, actual_time, _RC) - @assert_that(allocated(actual_interval), is(true())) - @assertTrue(actual_interval == expected_interval, MAKE_MESSAGE('timestep')) - @assertTrue(actual_time == expected_time, MAKE_MESSAGE('reference time')) + call parse_timespec(hconfig, actual_duration, actual_offset, _RC) + @assert_that(allocated(actual_duration), is(true())) + @assertTrue(actual_duration == expected_duration, MAKE_MESSAGE('timestep')) + @assertTrue(actual_offset == expected_offset, MAKE_MESSAGE('reference time offset')) call ESMF_HConfigDestroy(hconfig, _RC) - ! Test with incorrect key for timestep; should return without allocating actual_interval (invalid) + ! Test with incorrect key for timestep; should return without allocating actual_duration (invalid) expected_mm = 1 expected_time_array = [1583, 11, 16] - call ESMF_TimeIntervalSet(actual_interval, mm=expected_mm, _RC) - call ESMF_TimeSet(actual_time, yy=expected_time_array(1), mm=expected_time_array(2), dd=expected_time_array(3), _RC) + call ESMF_TimeIntervalSet(actual_duration, mm=expected_mm, _RC) content = 'run_dmc: ' // ISO_DURATION hconfig = ESMF_HConfigCreate(content=content, _RC) - call parse_timespec(hconfig, actual_interval, actual_time, _RC) - @assert_that(allocated(actual_interval), is(false())) - @assert_that(allocated(actual_time), is(false())) + call parse_timespec(hconfig, actual_duration, actual_offset, _RC) + @assert_that(allocated(actual_duration), is(false())) + @assert_that(allocated(actual_offset), is(false())) call ESMF_HConfigDestroy(hconfig, _RC) end subroutine test_parse_timespec diff --git a/generic3g/tests/Test_timestep_propagation.pf b/generic3g/tests/Test_timestep_propagation.pf index 62a410d30e82..3d1c387261a3 100644 --- a/generic3g/tests/Test_timestep_propagation.pf +++ b/generic3g/tests/Test_timestep_propagation.pf @@ -195,7 +195,7 @@ contains logical :: use_default_timestep logical :: use_default_refTime type(ESMF_TimeInterval), allocatable :: timeStep - type(ESMF_Time), allocatable :: refTime + type(ESMF_TimeInterval), allocatable :: offset type(ESMF_HConfig) :: hconfig rc=0 @@ -211,12 +211,12 @@ contains call MAPL_GridCompResourceGet(gridcomp, keystring='use_default_refTime', value=use_default_refTime, default=.true., _RC) if (.not. use_default_refTime) then - allocate(refTime) + allocate(offset) ! offset by 900 seconds - call ESMF_TimeSet(refTime, timeString="2000-04-03T20:45:00", _RC) + call ESMF_TimeIntervalSet(offset, timeIntervalString="PT900S", _RC) end if - child_spec = ChildSpec(user_SetServices(child_ss), timeStep=timeStep, refTime=refTime) + child_spec = ChildSpec(user_SetServices(child_ss), timeStep=timeStep, refTime_offset=offset) call MAPL_GridCompAddChild(gridcomp, 'child', child_spec, _RC) end subroutine parent_ss