diff --git a/generic3g/actions/AccumulatorActionInterface.F90 b/generic3g/actions/AccumulatorActionInterface.F90 index 9815b0fa6af..6b28580d36b 100644 --- a/generic3g/actions/AccumulatorActionInterface.F90 +++ b/generic3g/actions/AccumulatorActionInterface.F90 @@ -18,15 +18,18 @@ module mapl3g_AccumulatorActionInterface public :: MEAN_ACCUMULATION public :: MIN_ACCUMULATION public :: SIMPLE_ACCUMULATION - public :: NO_ACCUMULATION + public :: INSTANTANEOUS public :: accumulation_type_is_valid public :: get_accumulator_action + ! This is the default case where accumulation_type is not set. + character(len=*), parameter :: INSTANTANEOUS ='' + + ! These are explicit accumulation_type values. character(len=*), parameter :: MAX_ACCUMULATION = 'max' character(len=*), parameter :: MEAN_ACCUMULATION = 'mean' character(len=*), parameter :: MIN_ACCUMULATION = 'min' character(len=*), parameter :: SIMPLE_ACCUMULATION = 'simple' - character(len=*), parameter :: NO_ACCUMULATION ='' character(len=8), parameter :: ACCUMULATION_TYPES(4) = [character(len=8) :: & MAX_ACCUMULATION, MEAN_ACCUMULATION, MIN_ACCUMULATION, SIMPLE_ACCUMULATION] @@ -35,8 +38,9 @@ module mapl3g_AccumulatorActionInterface logical function accumulation_type_is_valid(acctype) result(lval) character(len=*), optional, intent(in) :: acctype - lval = present(acctype) - if(lval) lval = any(ACCUMULATION_TYPES == acctype) + lval = .FALSE. + if(.not. present(acctype)) return + lval = any(ACCUMULATION_TYPES == acctype) end function accumulation_type_is_valid @@ -48,10 +52,7 @@ subroutine get_accumulator_action(accumulation_type, typekind, action, rc) integer :: status - if(typekind /= ESMF_TYPEKIND_R4) then - _FAIL('Unsupported typekind') - end if - _ASSERT(accumulation_type_is_valid(accumulation_type), 'Unsupported AccumulatorAction') + _ASSERT(typekind == ESMF_TYPEKIND_R4, 'Unsupported typekind') select case(accumulation_type) case (SIMPLE_ACCUMULATION) @@ -62,6 +63,8 @@ subroutine get_accumulator_action(accumulation_type, typekind, action, rc) allocate(action, source=MaxAction(typekind)) case (MIN_ACCUMULATION) allocate(action, source=MinAction(typekind)) + case (INSTANTANEOUS) + _FAIL('No AccumulatorAction for instantaneous.') case default _FAIL('Unsupported AccumulatorAction') end select diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index ae3405ce1f7..fc48af5f9b2 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -201,7 +201,7 @@ function new_FieldSpec_geom(unusable, geom, vertical_grid, vertical_dim_spec, ty ! regrid_param if (present(default_value)) field_spec%default_value = default_value - field_spec%accumulation_type = NO_ACCUMULATION + field_spec%accumulation_type = INSTANTANEOUS if (present(accumulation_type)) field_spec%accumulation_type = trim(accumulation_type) if (present(run_dt)) field_spec%run_dt = run_dt end function new_FieldSpec_geom @@ -212,7 +212,7 @@ function new_FieldSpec_varspec(variable_spec) result(field_spec) type(ESMF_RegridMethod_Flag), allocatable :: regrid_method - field_spec%accumulation_type = NO_ACCUMULATION + field_spec%accumulation_type = INSTANTANEOUS _SET_FIELD(field_spec, variable_spec, vertical_dim_spec) _SET_FIELD(field_spec, variable_spec, attributes) _SET_ALLOCATED_FIELD(field_spec, variable_spec, standard_name) diff --git a/generic3g/specs/FrequencyAspect.F90 b/generic3g/specs/FrequencyAspect.F90 index daac5a08515..68f26fbd444 100644 --- a/generic3g/specs/FrequencyAspect.F90 +++ b/generic3g/specs/FrequencyAspect.F90 @@ -9,14 +9,14 @@ module mapl3g_FrequencyAspect public :: FrequencyAspect type, extends(StateItemAspect) :: FrequencyAspect - type(ESMF_TimeInterval) :: dt + type(ESMF_TimeInterval) :: timestep character(len=:), allocatable :: accumulation_type contains procedure :: matches procedure :: supports_conversion_general procedure :: supports_conversion_specific procedure :: make_action - procedure :: set_dt + procedure :: set_timestep procedure :: set_accumulation_type end type FrequencyAspect @@ -25,71 +25,82 @@ module mapl3g_FrequencyAspect end interface FrequencyAspect interface operator(.divides.) - module procedure :: divides + module procedure :: aspect_divides end interface operator(.divides.) + ! This value should not be accessed directly. Use zero() instead. + ! There is no constructor for ESMF_TimeInterval, so the value cannot be initialized + ! at construction. The zero() function initializes the value the first time + ! and returns a pointer to the value. + type(ESMF_TimeInterval), target :: ZERO_TI + contains - function construct_frequency_aspect(dt, accumulation_type) result(aspect) + function construct_frequency_aspect(timestep, accumulation_type) result(aspect) type(FrequencyAspect) :: aspect - type(ESMF_TimeInterval), optional, intent(in) :: dt + type(ESMF_TimeInterval), optional, intent(in) :: timestep character(len=*), optional, intent(in) :: accumulation_type - aspect%accumulation_type = NO_ACCUMULATION - call ESMF_TimeIntervalSet(aspect%dt, ns=0) + aspect%mirror = .FALSE. + aspect%time_dependent = .FALSE. + aspect%accumulation_type = INSTANTANEOUS + call ESMF_TimeIntervalSet(aspect%timestep, ns=0) + if(present(accumulation_type)) then call aspect%set_accumulation_type(accumulation_type) end if - if(present(dt)) then - call aspect%set_dt(dt) + + if(present(timestep)) then + call aspect%set_timestep(timestep) end if - aspect%mirror = .FALSE. - aspect%time_dependent = .FALSE. end function construct_frequency_aspect - subroutine set_dt(this, dt) + subroutine set_timestep(this, timestep) class(FrequencyAspect), intent(inout) :: this - type(ESMF_TimeInterval), intent(in) :: dt + type(ESMF_TimeInterval), intent(in) :: timestep - this%run_dt = dt + this%timestep = timestep - end subroutine set_dt + end subroutine set_timestep subroutine set_accumulation_type(this, accumulation_type) class(FrequencyAspect), intent(inout) :: this character(len=*), intent(in) :: accumulation_type - if(accumulation_type_is_valid(accumulation_type)) this%accumulation_type = accumulation_type + if(accumulation_type == INSTANTANEOUS .or. accumulation_type_is_valid(accumulation_type)) then + this%accumulation_type = accumulation_type + end if end subroutine set_accumulation_type - logical function matches(this, aspect) result(does_match) - class(FrequencyAspect), intent(in) :: this - class(StateItemAspect), intent(in) :: aspect + logical function matches(src, dst) result(does_match) + class(FrequencyAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst - does_match = .FALSE. - if(is_zero(this%dt)) return + does_match = .TRUE. + if(src%timestep == zero()) return select type(StateItemAspect) class is (FrequencyAspect) - if(is_zero(aspect%dt)) return - does_match = this%dt == aspect%dt + if(dst%timestep == zero()) return + if(.not. accumulation_type_is_valid(dst%accumulation_type)) return + does_match = src%timestep == dst%timestep end select end function matches - function make_action(this, aspect, rc) result(action) + function make_action(src, dst, rc) result(action) use mapl3g_ExtensionAction class(ExtensionAction), allocatable :: action - class(FrequencyAspect), intent(in) :: this - class(StateItemAspect), intent(in) :: aspect + class(FrequencyAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst integer, optional, intent(out) :: rc integer :: status allocate(action, source=NullAction()) - select type(aspect) + select type(dst) class is (FrequencyAspect) - call get_accumulator_action(aspect%accumulation_type, ESMF_TYPEKIND_R4, action, _RC) + call get_accumulator_action(dst%accumulation_type, ESMF_TYPEKIND_R4, action, _RC) _ASSERT(allocated(action), 'Unable to allocate action') class default _FAIL('FrequencyAspect cannot convert from other class.') @@ -101,55 +112,49 @@ end function make_action logical function supports_conversion_general(this) result(supports) class(FrequencyAspect), intent(in) :: this - supports = .not. is_zero(this%dt) + supports = .TRUE. end function supports_conversion_general - logical function supports_conversion_specific(this, aspect) result(supports) - class(FrequencyAspect), intent(in) :: this - class(StateItemAspect), intent(in) :: aspect + logical function supports_conversion_specific(src, dst) result(supports) + class(FrequencyAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst - supports = .FALSE. - if(is_zero(this%dt)) return - select type(aspect) + select type(dst) class is (FrequencyAspect) - if(is_zero(aspect%dt)) return - if(.not. accumulation_type_is_valid(aspect%accumulation_type)) return - supports = aspect .divides. this + supports = src .divides. dst end select end function supports_conversion_specific - elemental function are_nonzero(ti) - logical :: are_nonzero - type(ESMF_TimeInterval), intent(in) :: ti - type(ESMF_TimeInterval), save :: zero - logical :: uninitialized :: .TRUE. + logical function aspect_divides(factor, base) + class(FrequencyAspect), intent(in) :: factor + class(FrequencyAspect), intent(in) :: base - if(uninitialized) then - call ESMF_TimeIntervalSet(zero, ns=0) - uninitialized = .FALSE. - end if - are_nonzero = ti > zero + aspect_divides = interval_divides(factor%timestep, base%timestep) - end function are_nonzero + end function aspect_divides - logical function is_zero(ti) - type(ESMF_TimeInterval), intent(in) :: ti + logical function interval_divides(factor, base) result(lval) + type(ESMF_TimeInterval), intent(in) :: factor + type(ESMF_TimeInterval), intent(in) :: base - is_zero = .not. are_nonzero(ti) + lval = .FALSE. + if(factor == zero()) return + lval = mod(base, factor) == zero() - end function is_zero + end function interval_divides - logical function divides(factor, base) result(lval) - class(FrequencyAspect), intent(in) :: factor - class(FrequencyAspect), intent(in) :: base + function zero() + type(ESMF_TimeInterval), pointer :: zero + logical, save :: zero_is_uninitialized = .TRUE. - lval = .FALSE. - if(all(are_nonzero([base%dt, factor%dt]))) then - lval = is_zero(mod(base%dt, factor%dt)) + if(zero_is_uninitialized) then + call ESMF_TimeIntervalSet(ZERO_TI, ns=0) + zero_is_uninitialized = .FALSE. end if + zero => ZERO_TI - end function divides + end function zero end module mapl3g_FrequencyAspect