Merge pull request #3266 from GEOS-ESM/feature/tclune/#3264-producer-…

…consumer-swap

Feature/tclune/#3264 producer consumer swap

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