Fixes #3264 - Swap ownership of consumer

StateItemExtensions now own the consumers rather than the producers.
This change was motivated by the fact that imports and "final"
extensions need to share the producer, whereas consumers always
associated with a unique item - the one that generates the extension.

Various other interfaces needed to be updated. Primarily many
references to GriddedComponentDriver now need to be refrences to the
abstract parent: ComponentDriver, which is actually a good thing in
and of itself.

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

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

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
 

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
 

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

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

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

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