diff --git a/generic3g/ComponentDriver.F90 b/generic3g/ComponentDriver.F90 index 7ec2beec0b32..4ec9370969eb 100644 --- a/generic3g/ComponentDriver.F90 +++ b/generic3g/ComponentDriver.F90 @@ -4,6 +4,7 @@ module mapl3g_ComponentDriver use mapl3g_MultiState use mapl_ErrorHandlingMod use :: MaplShared, only: KeywordEnforcer + use mapl3g_MultiState use :: esmf implicit none private @@ -20,6 +21,8 @@ module mapl3g_ComponentDriver procedure(I_run), deferred :: finalize procedure(I_run), deferred :: read_restart procedure(I_run), deferred :: write_restart + + procedure(I_get_states), deferred :: get_states end type ComponentDriver type :: ComponentDriverPtr @@ -37,6 +40,13 @@ recursive subroutine I_run(this, unusable, phase_idx, rc) integer, optional, intent(out) :: rc end subroutine I_run + function I_get_states(this) result(states) + import ComponentDriver + import multistate + type(MultiState) :: states + class(ComponentDriver), intent(in) :: this + end function I_get_states + end interface contains diff --git a/generic3g/actions/VerticalRegridAction.F90 b/generic3g/actions/VerticalRegridAction.F90 index 68481c12d75c..aa0d0778b14a 100644 --- a/generic3g/actions/VerticalRegridAction.F90 +++ b/generic3g/actions/VerticalRegridAction.F90 @@ -4,7 +4,7 @@ module mapl3g_VerticalRegridAction use mapl_ErrorHandling use mapl3g_ExtensionAction - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_CouplerPhases, only: GENERIC_COUPLER_UPDATE use mapl3g_VerticalRegridMethod use mapl3g_VerticalLinearMap, only: compute_linear_map @@ -24,8 +24,8 @@ module mapl3g_VerticalRegridAction type, extends(ExtensionAction) :: VerticalRegridAction type(ESMF_Field) :: v_in_coord, v_out_coord type(SparseMatrix_sp), allocatable :: matrix(:) - type(GriddedComponentDriver), pointer :: v_in_coupler => null() - type(GriddedComponentDriver), pointer :: v_out_coupler => null() + class(ComponentDriver), pointer :: v_in_coupler => null() + class(ComponentDriver), pointer :: v_out_coupler => null() type(VerticalRegridMethod) :: method = VERTICAL_REGRID_UNKNOWN contains procedure :: initialize @@ -43,9 +43,9 @@ module mapl3g_VerticalRegridAction function new_VerticalRegridAction(v_in_coord, v_in_coupler, v_out_coord, v_out_coupler, method) result(action) type(VerticalRegridAction) :: action type(ESMF_Field), intent(in) :: v_in_coord - type(GriddedComponentDriver), pointer, intent(in) :: v_in_coupler + class(ComponentDriver), pointer, intent(in) :: v_in_coupler type(ESMF_Field), intent(in) :: v_out_coord - type(GriddedComponentDriver), pointer, intent(in) :: v_out_coupler + class(ComponentDriver), pointer, intent(in) :: v_out_coupler type(VerticalRegridMethod), intent(in) :: method action%v_in_coord = v_in_coord diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90 index f4506f8177cb..82329b23ed55 100644 --- a/generic3g/connection/SimpleConnection.F90 +++ b/generic3g/connection/SimpleConnection.F90 @@ -173,7 +173,6 @@ recursive subroutine connect_sibling(this, dst_registry, src_registry, unusable, if (new_extension%has_producer()) then call dst_extension%set_producer(new_extension%get_producer(), _RC) -!# dst_extension%dependency => new_extension%get_producer() end if end do diff --git a/generic3g/couplers/CouplerMetaComponent.F90 b/generic3g/couplers/CouplerMetaComponent.F90 index a8b086c30b69..d2e1af62f2db 100644 --- a/generic3g/couplers/CouplerMetaComponent.F90 +++ b/generic3g/couplers/CouplerMetaComponent.F90 @@ -65,7 +65,7 @@ module mapl3g_CouplerMetaComponent function new_CouplerMetaComponent(action, source) result (this) type(CouplerMetaComponent) :: this class(ExtensionAction), intent(in) :: action - type(GriddedComponentDriver), target, optional, intent(in) :: source + class(ComponentDriver), target, optional, intent(in) :: source type(ComponentDriverPtr) :: source_wrapper diff --git a/generic3g/couplers/GenericCoupler.F90 b/generic3g/couplers/GenericCoupler.F90 index 851b9c721076..e0b3a2c83919 100644 --- a/generic3g/couplers/GenericCoupler.F90 +++ b/generic3g/couplers/GenericCoupler.F90 @@ -6,7 +6,7 @@ module mapl3g_GenericCoupler use mapl3g_CouplerMetaComponent use mapl3g_ExtensionAction use mapl3g_VerticalRegridAction - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl_ErrorHandlingMod use esmf @@ -23,7 +23,7 @@ module mapl3g_GenericCoupler function make_coupler(action, source, rc) result(coupler_gridcomp) type(ESMF_GridComp) :: coupler_gridcomp class(ExtensionAction), intent(in) :: action - type(GriddedComponentDriver), target, optional, intent(in) :: source + class(ComponentDriver), target, optional, intent(in) :: source integer, optional, intent(out) :: rc integer :: status diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90 index 643838b4b1c3..79ddbf89dd98 100644 --- a/generic3g/registry/StateItemExtension.F90 +++ b/generic3g/registry/StateItemExtension.F90 @@ -5,7 +5,7 @@ module mapl3g_StateItemExtension use mapl3g_ComponentDriver use mapl3g_GriddedComponentDriver use mapl3g_ComponentDriverVector - use mapl3g_ComponentDriverPtrVector + use mapl3g_ComponentDriverVector use mapl3g_ExtensionAction use mapl3g_GenericCoupler use mapl3g_StateItemAspect @@ -25,16 +25,19 @@ module mapl3g_StateItemExtension type StateItemExtension private class(StateItemSpec), allocatable :: spec - type(GriddedComponentDriver), allocatable :: producer ! coupler that computes spec - type(ComponentDriverPtrVector) :: consumers ! couplers that depend on spec + type(ComponentDriverVector) :: consumers ! couplers that depend on spec + class(ComponentDriver), pointer :: producer => null() ! coupler that computes spec contains procedure :: get_spec + + procedure :: has_producer procedure :: get_producer procedure :: set_producer - procedure :: get_consumers - procedure :: has_producer + procedure :: has_consumers procedure :: add_consumer + procedure :: get_consumers + procedure :: make_extension end type StateItemExtension @@ -44,7 +47,6 @@ module mapl3g_StateItemExtension interface StateItemExtension procedure :: new_StateItemExtension_spec - procedure :: new_StateItemExtension_w_producer end interface StateItemExtension contains @@ -55,14 +57,6 @@ function new_StateItemExtension_spec(spec) result(ext) ext%spec = spec end function new_StateItemExtension_spec - function new_StateItemExtension_w_producer(spec, producer) result(ext) - type(StateItemExtension) :: ext - class(StateItemSpec), intent(in) :: spec - type(GriddedComponentDriver), intent(in) :: producer - ext%spec = spec - ext%producer = producer - end function new_StateItemExtension_w_producer - function get_spec(this) result(spec) class(StateItemExtension), target, intent(in) :: this class(StateItemSpec), pointer :: spec @@ -71,57 +65,58 @@ end function get_spec logical function has_producer(this) class(StateItemExtension), target, intent(in) :: this - has_producer = allocated(this%producer) + has_producer = associated(this%producer) end function has_producer - logical function has_consumers(this) - class(StateItemExtension), target, intent(in) :: this - has_consumers = this%consumers%size() > 0 - end function has_consumers - function get_producer(this) result(producer) class(StateItemExtension), target, intent(in) :: this - type(GriddedComponentDriver), pointer :: producer + class(ComponentDriver), pointer :: producer - producer => null() - if (.not. allocated(this%producer)) return producer => this%producer end function get_producer subroutine set_producer(this, producer, rc) class(StateItemExtension), intent(inout) :: this - type(GriddedComponentDriver), intent(in) :: producer + class(ComponentDriver), pointer, intent(in) :: producer integer, optional, intent(out) :: rc _ASSERT(.not. this%has_producer(), 'cannot set producer for extension that already has one') - this%producer = producer + this%producer => producer _RETURN(_SUCCESS) end subroutine set_producer + + logical function has_consumers(this) + class(StateItemExtension), target, intent(in) :: this + has_consumers = this%consumers%size() > 0 + end function has_consumers + + function get_consumers(this) result(consumers) class(StateItemExtension), target, intent(in) :: this - type(ComponentDriverPtrVector), pointer :: consumers + type(ComponentDriverVector), pointer :: consumers consumers => this%consumers end function get_consumers - subroutine add_consumer(this, consumer) - class(StateItemExtension), intent(inout) :: this - type(GriddedComponentDriver), pointer :: consumer - type(ComponentDriverPtr) :: wrapper + function add_consumer(this, consumer) result(reference) + class(ComponentDriver), pointer :: reference + class(StateItemExtension), target, intent(inout) :: this + type(GriddedComponentDriver), intent(in) :: consumer + + call this%consumers%push_back(consumer) + reference => this%consumers%back() - wrapper%ptr => consumer - call this%consumers%push_back(wrapper) - end subroutine add_consumer + end function add_consumer ! Creation of an extension requires a new coupler that transforms - ! from source (this) spec to dest (extension) spec. This new coupler - ! is added to the export specs of source (this), and the new extension - ! gains it as a reference (pointer). + ! from source (this) spec to dest (extension) spec. + ! This coupler is a "consumer" of the original spec (this), and a "producer" of + ! the new spec (extension). recursive function make_extension(this, goal, rc) result(extension) - type(StateItemExtension), target :: extension + type(StateItemExtension) :: extension class(StateItemExtension), target, intent(inout) :: this class(StateItemSpec), target, intent(in) :: goal integer, intent(out) :: rc @@ -130,8 +125,8 @@ recursive function make_extension(this, goal, rc) result(extension) integer :: i class(StateItemSpec), allocatable :: new_spec class(ExtensionAction), allocatable :: action - type(GriddedComponentDriver) :: producer - type(GriddedComponentDriver), pointer :: source + class(ComponentDriver), pointer :: producer + class(ComponentDriver), pointer :: source type(ESMF_GridComp) :: coupler_gridcomp type(StateItemAdapterWrapper), allocatable :: adapters(:) type(ESMF_Clock) :: fake_clock @@ -166,8 +161,9 @@ recursive function make_extension(this, goal, rc) result(extension) call new_spec%set_active() source => this%get_producer() coupler_gridcomp = make_coupler(action, source, _RC) - producer = GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState()) - extension = StateItemExtension(new_spec, producer) + producer => this%add_consumer(GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState())) + extension = StateItemExtension(new_spec) + call extension%set_producer(producer) _RETURN(_SUCCESS) end if @@ -191,8 +187,9 @@ recursive function make_extension(this, goal, rc) result(extension) source => this%get_producer() coupler_gridcomp = make_coupler(action, source, _RC) - producer = GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState()) - extension = StateItemExtension(new_spec, producer) + producer => this%add_consumer(GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState())) + extension = StateItemExtension(new_spec) + call extension%set_producer(producer) _RETURN(_SUCCESS) end function make_extension diff --git a/generic3g/registry/StateRegistry.F90 b/generic3g/registry/StateRegistry.F90 index b9b31ec6d120..fc0a578ca51e 100644 --- a/generic3g/registry/StateRegistry.F90 +++ b/generic3g/registry/StateRegistry.F90 @@ -493,7 +493,6 @@ subroutine propagate_exports_virtual_pt(this, subregistry_name, iter, rc) type(VirtualConnectionPt) :: new_virtual_pt type(ExtensionFamily), pointer :: family type(ExtensionFamily), pointer :: parent_family - type(VirtualPtFamilyMapIterator) :: new_iter virtual_pt => iter%first() _RETURN_UNLESS(virtual_pt%is_export()) @@ -743,17 +742,17 @@ end function filter ! - has a consumer ! - has no producers ! The export couplers are all consumers. + function get_export_couplers(this) result(export_couplers) type(ComponentDriverPtrVector) :: export_couplers class(StateRegistry), target, intent(in) :: this - type(ComponentDriverPtr) :: wrapper type(StateItemExtension), pointer :: extension type(StateItemExtensionVectorIterator) :: iter - type(ComponentDriverPtrVector), pointer :: consumers + type(ComponentDriverVector), pointer :: consumers + type(ComponentDriverPtr) :: wrapper integer :: i - associate (e => this%owned_items%ftn_end()) iter = this%owned_items%ftn_begin() do while (iter /= e) @@ -763,7 +762,7 @@ function get_export_couplers(this) result(export_couplers) if (extension%has_producer()) cycle consumers => extension%get_consumers() do i = 1, consumers%size() - wrapper = consumers%of(i) ! copy ptr + wrapper%ptr => consumers%of(i) ! copy ptr call export_couplers%push_back(wrapper) end do @@ -772,14 +771,20 @@ function get_export_couplers(this) result(export_couplers) end function get_export_couplers - ! An item is an import coupler iff: - ! - it is has a producer, but no consumer (end of chain) - ! - is primary + ! An item has an import coupler iff: + ! - is has a producer + ! - it has no consumers + ! - it is NOT an extension + ! + ! That last condition is to prevent treating "ultimate" extensions + ! as having an import coupler. These would be the same couplers + ! but would be activate at the connection level rather than + ! the owning grid comp. + function get_import_couplers(this) result(import_couplers) type(ComponentDriverPtrVector) :: import_couplers class(StateRegistry), target, intent(in) :: this - type(VirtualPtFamilyMapIterator) :: family_iter type(ExtensionFamily), pointer :: family type(VirtualConnectionPt), pointer :: v_pt @@ -804,8 +809,8 @@ function get_import_couplers(this) result(import_couplers) end do end associate - - end function get_import_couplers + + end function get_import_couplers ! Repeatedly extend family at v_pt until extension can directly ! connect to goal_spec. @@ -821,7 +826,7 @@ recursive function extend(registry, v_pt, goal_spec, rc) result(extension) type(StateItemExtension), pointer :: closest_extension, new_extension type(StateItemExtension) :: tmp_extension type(ExtensionFamily), pointer :: family - type(GriddedComponentDriver), pointer :: producer + class(ComponentDriver), pointer :: producer integer :: iter_count integer, parameter :: MAX_ITERATIONS = 10 integer :: status @@ -852,7 +857,6 @@ recursive function extend(registry, v_pt, goal_spec, rc) result(extension) a_pt = ActualConnectionPt(VirtualConnectionPt(state_intent='export', short_name='export[1]')) new_spec => new_extension%get_spec() call new_spec%add_to_state(coupler_states, a_pt, _RC) - call closest_extension%add_consumer(producer) closest_extension => new_extension end do diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index fc6345afdce4..e0beff8d3ed7 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -42,7 +42,7 @@ module mapl3g_FieldSpec use mapl3g_LU_Bound use mapl3g_geom_mgr, only: MAPL_SameGeom use mapl3g_FieldDictionary - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VariableSpec, only: VariableSpec use mapl3g_VerticalRegridMethod use mapl3g_AccumulatorActionInterface @@ -829,8 +829,8 @@ subroutine adapt_vertical_grid(this, spec, action, rc) class(ExtensionAction), allocatable, intent(out) :: action integer, optional, intent(out) :: rc - type(GriddedComponentDriver), pointer :: v_in_coupler - type(GriddedComponentDriver), pointer :: v_out_coupler + class(ComponentDriver), pointer :: v_in_coupler + class(ComponentDriver), pointer :: v_out_coupler type(ESMF_Field) :: v_in_coord, v_out_coord type(ESMF_TypeKind_Flag) :: typekind_in, typekind_out type(ESMF_Geom) :: geom diff --git a/generic3g/tests/Test_ModelVerticalGrid.pf b/generic3g/tests/Test_ModelVerticalGrid.pf index f9ff44a515be..0f6f5416771e 100644 --- a/generic3g/tests/Test_ModelVerticalGrid.pf +++ b/generic3g/tests/Test_ModelVerticalGrid.pf @@ -17,7 +17,7 @@ module Test_ModelVerticalGrid use mapl3g_ActualConnectionPt use mapl3g_StateItemSpec use mapl3g_StateItemExtension - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_ComponentDriver use mapl3g_ComponentDriverVector use mapl3g_ComponentDriverPtrVector @@ -168,7 +168,7 @@ contains subroutine test_get_coordinate_field_simple(this) class(ESMF_TestMethod), intent(inout) :: this type(ModelVerticalGrid) :: vgrid - type(GriddedComponentDriver), pointer :: coupler + class(ComponentDriver), pointer :: coupler type(ESMF_Field) :: vcoord type(ESMF_Geom) :: geom integer :: rc, status @@ -205,7 +205,7 @@ contains real(ESMF_KIND_R4), pointer :: a(:,:,:) type(ComponentDriverPtrVector) :: couplers type(ComponentDriverPtr) :: driver - type(GriddedComponentDriver), pointer :: coupler + class(ComponentDriver), pointer :: coupler integer :: i, rc call setup(geom, vgrid, _RC) @@ -250,7 +250,7 @@ contains real(ESMF_KIND_R4), pointer :: a(:,:,:) type(ComponentDriverPtrVector) :: couplers type(ComponentDriverPtr) :: driver - type(GriddedComponentDriver), pointer :: coupler + class(ComponentDriver), pointer :: coupler integer :: i, rc call setup(geom, vgrid, _RC) diff --git a/generic3g/vertical/BasicVerticalGrid.F90 b/generic3g/vertical/BasicVerticalGrid.F90 index 6ba07808ed50..16c6ed1ef94b 100644 --- a/generic3g/vertical/BasicVerticalGrid.F90 +++ b/generic3g/vertical/BasicVerticalGrid.F90 @@ -5,7 +5,7 @@ module mapl3g_BasicVerticalGrid use mapl_ErrorHandling use mapl3g_VerticalGrid use mapl3g_MirrorVerticalGrid - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VerticalDimSpec use esmf, only: ESMF_TypeKind_Flag use esmf, only: ESMF_Field @@ -57,7 +57,7 @@ function get_num_levels(this) result(num_levels) subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typekind, units, vertical_dim_spec, rc) class(BasicVerticalGrid), intent(in) :: this type(ESMF_Field), intent(out) :: field - type(GriddedComponentDriver), pointer, intent(out) :: coupler + class(ComponentDriver), pointer, intent(out) :: coupler character(*), intent(in) :: standard_name type(ESMF_Geom), intent(in) :: geom type(ESMF_TypeKind_Flag), intent(in) :: typekind diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index f9ab06ad16bc..8f9abd566888 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -7,7 +7,7 @@ module mapl3g_FixedLevelsVerticalGrid use mapl3g_MirrorVerticalGrid use mapl3g_VerticalStaggerLoc use mapl3g_FieldCreate - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VerticalDimSpec use mapl3g_FieldCondensedArray, only: assign_fptr_condensed_array use esmf @@ -65,7 +65,7 @@ end function get_num_levels subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typekind, units, vertical_dim_spec, rc) class(FixedLevelsVerticalGrid), intent(in) :: this type(ESMF_Field), intent(out) :: field - type(GriddedComponentDriver), pointer, intent(out) :: coupler + class(ComponentDriver), pointer, intent(out) :: coupler character(*), intent(in) :: standard_name type(ESMF_Geom), intent(in) :: geom type(ESMF_TypeKind_Flag), intent(in) :: typekind diff --git a/generic3g/vertical/MirrorVerticalGrid.F90 b/generic3g/vertical/MirrorVerticalGrid.F90 index 2c6048962a87..bffe5bdeaf94 100644 --- a/generic3g/vertical/MirrorVerticalGrid.F90 +++ b/generic3g/vertical/MirrorVerticalGrid.F90 @@ -9,7 +9,7 @@ module mapl3g_MirrorVerticalGrid use mapl_ErrorHandling use mapl3g_VerticalGrid - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VerticalDimSpec use esmf, only: ESMF_TypeKind_Flag use esmf, only: ESMF_Field @@ -50,7 +50,7 @@ function get_num_levels(this) result(num_levels) subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typekind, units, vertical_dim_spec, rc) class(MirrorVerticalGrid), intent(in) :: this type(ESMF_Field), intent(out) :: field - type(GriddedComponentDriver), pointer, intent(out) :: coupler + class(ComponentDriver), pointer, intent(out) :: coupler character(*), intent(in) :: standard_name type(ESMF_Geom), intent(in) :: geom type(ESMF_TypeKind_Flag), intent(in) :: typekind diff --git a/generic3g/vertical/ModelVerticalGrid.F90 b/generic3g/vertical/ModelVerticalGrid.F90 index d290b417384c..2e6851751b33 100644 --- a/generic3g/vertical/ModelVerticalGrid.F90 +++ b/generic3g/vertical/ModelVerticalGrid.F90 @@ -15,7 +15,7 @@ module mapl3g_ModelVerticalGrid use mapl3g_StateItemExtension use mapl3g_ExtensionFamily use mapl3g_ExtensionAction - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VerticalDimSpec use esmf @@ -123,7 +123,7 @@ end function get_registry subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typekind, units, vertical_dim_spec, rc) class(ModelVerticalGrid), intent(in) :: this type(ESMF_Field), intent(out) :: field - type(GriddedComponentDriver), pointer, intent(out) :: coupler + class(ComponentDriver), pointer, intent(out) :: coupler character(*), intent(in) :: standard_name type(ESMF_Geom), intent(in) :: geom type(ESMF_TypeKind_Flag), intent(in) :: typekind diff --git a/generic3g/vertical/VerticalGrid.F90 b/generic3g/vertical/VerticalGrid.F90 index 307814540b6c..c31b661994c1 100644 --- a/generic3g/vertical/VerticalGrid.F90 +++ b/generic3g/vertical/VerticalGrid.F90 @@ -37,14 +37,14 @@ integer function I_get_num_levels(this) result(num_levels) end function I_get_num_levels subroutine I_get_coordinate_field(this, field, coupler, standard_name, geom, typekind, units, vertical_dim_spec, rc) - use mapl3g_GriddedComponentDriver + use mapl3g_ComponentDriver use mapl3g_VerticalDimSpec use esmf, only: ESMF_Geom, ESMF_TypeKind_Flag, ESMF_Field import VerticalGrid class(VerticalGrid), intent(in) :: this type(ESMF_Field), intent(out) :: field - type(GriddedComponentDriver), pointer, intent(out) :: coupler + class(ComponentDriver), pointer, intent(out) :: coupler character(*), intent(in) :: standard_name type(ESMF_Geom), intent(in) :: geom type(ESMF_TypeKind_Flag), intent(in) :: typekind