Refactor make_extension()

With adaptors, we can now implent make_extension() independent of the StateItemSpec subclasses. Reviewed-by: Tom Clune <[email protected]>
GEOS-ESM · Sep 19, 2024 · da23940 · da23940
1 parent 5f09400
commit da23940
Show file tree

Hide file tree

Showing 10 changed files with 12 additions and 266 deletions.
diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90
@@ -205,40 +205,6 @@ subroutine activate_dependencies(extension, registry, rc)
       _RETURN(_SUCCESS)
    end subroutine activate_dependencies
 
-!#   subroutine find_closest_extension(goal_extension, candidate_extensions, closest_extension, lowest_cost, rc)
-!#      type(StateItemExtension), intent(in) :: goal_extension
-!#      type(StateItemExtensionPtr), target, intent(in) :: candidate_extensions(:)
-!#      type(StateItemExtension), pointer :: closest_extension
-!#      integer, intent(out) :: lowest_cost
-!#      integer, optional, intent(out) :: rc
-!#
-!#      integer :: status
-!#      type(StateItemExtension), pointer :: extension
-!#      class(StateItemSpec), pointer :: spec
-!#      class(StateItemSpec), pointer :: goal_spec
-!#      integer :: cost
-!#      integer :: j
-!#      
-!#      _ASSERT(size(candidate_extensions) > 0, 'no candidates found')
-!#
-!#      goal_spec => goal_extension%get_spec()
-!#      closest_extension => candidate_extensions(1)%ptr
-!#      spec => closest_extension%get_spec()
-!#      lowest_cost = goal_spec%extension_cost(spec, _RC)
-!#      do j = 2, size(candidate_extensions)
-!#         if (lowest_cost == 0) exit
-!#
-!#         extension => candidate_extensions(j)%ptr
-!#         spec => extension%get_spec()
-!#         cost = goal_spec%extension_cost(spec)
-!#         if (cost < lowest_cost) then
-!#            lowest_cost = cost
-!#            closest_extension => extension
-!#         end if
-!#
-!#      end do
-!#
-!#   end subroutine find_closest_extension
 
 end module mapl3g_SimpleConnection
 
diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90
@@ -111,22 +111,28 @@ function make_extension(this, goal, rc) result(extension)
       integer, intent(out) :: rc
 
       integer :: status
+      integer :: i
       class(StateItemSpec), allocatable :: new_spec
       class(ExtensionAction), allocatable :: action
       type(GriddedComponentDriver) :: producer
       type(ESMF_GridComp) :: coupler_gridcomp
+      type(StateItemAdapterWrapper), allocatable :: adapters(:)
       type(ESMF_Clock) :: fake_clock
 
       call this%spec%set_active()
-      call this%spec%make_extension(goal, new_spec, action, _RC)
 
-      ! If no action is needed, then "this" can already directly
-      ! connect to goal.  I.e., extensions have converged.
-      select type (action)
-      type is (NullAction)
+      new_spec = this%spec
+      adapters = this%spec%make_adapters(goal, _RC)
+      do i = 1, size(adapters)
+         if (adapters(i)%adapter%match(new_spec)) cycle
+         call adapters(i)%adapter%adapt(new_spec, action)
+         exit
+      end do
+
+      if (.not. allocated(action)) then
          extension = StateItemExtension(this%spec)
          _RETURN(_SUCCESS)
-      end select
+      end if
 
       call new_spec%create(_RC)
       call new_spec%set_active()

diff --git a/generic3g/specs/BracketSpec.F90 b/generic3g/specs/BracketSpec.F90
@@ -44,7 +44,6 @@ module mapl3g_BracketSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
       procedure :: make_adapters
       procedure :: set_geometry
    end type BracketSpec
@@ -255,21 +254,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _UNUSED_DUMMY(bundle)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(BracketSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(BracketSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom

diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90
@@ -104,7 +104,6 @@ module mapl3g_FieldSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
       procedure :: make_adapters
 
       procedure :: set_info
@@ -1040,32 +1039,6 @@ recursive function make_adapters(this, goal_spec, rc) result(adapters)
 
    end function make_adapters
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(FieldSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      type(StateItemAdapterWrapper), allocatable :: adapters(:)
-      integer :: i
-      integer :: status
-
-      new_spec = this
-      adapters = this%make_adapters(dst_spec, _RC)
-      do i = 1, size(adapters)
-         if (adapters(i)%adapter%match(new_spec)) cycle
-         call adapters(i)%adapter%adapt(new_spec, action)
-         exit
-      end do
-     _RETURN_IF(allocated(action))
-
-      ! no action needed
-      action = NullAction()
-
-      _RETURN(_SUCCESS)
-   end subroutine make_extension
-
 
 end module mapl3g_FieldSpec
 

diff --git a/generic3g/specs/InvalidSpec.F90 b/generic3g/specs/InvalidSpec.F90
@@ -34,8 +34,6 @@ module mapl3g_InvalidSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_extension
-      procedure :: extension_cost
       procedure :: set_geometry => set_geometry
 
       procedure :: make_adapters
@@ -140,35 +138,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _UNUSED_DUMMY(bundle)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(InvalidSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('attempt to use item of type InvalidSpec')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
-   integer function extension_cost(this, src_spec, rc) result(cost)
-      class(InvalidSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: src_spec
-      integer, optional, intent(out) :: rc
-
-      cost = -1
-      _FAIL('Attempt to use item of type InvalidSpec')
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(src_spec)
-
-   end function extension_cost
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(InvalidSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom

diff --git a/generic3g/specs/ServiceSpec.F90 b/generic3g/specs/ServiceSpec.F90
@@ -40,7 +40,6 @@ module mapl3g_ServiceSpec
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
       procedure :: make_adapters
 
       procedure :: add_to_state
@@ -185,21 +184,6 @@ subroutine destroy(this, rc)
    end subroutine destroy
 
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(ServiceSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _RETURN(_SUCCESS)
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(ServiceSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom

diff --git a/generic3g/specs/StateItemSpec.F90 b/generic3g/specs/StateItemSpec.F90
@@ -46,8 +46,6 @@ module mapl3g_StateItemSpec
 
       procedure(I_connect), deferred :: connect_to
       procedure(I_can_connect), deferred :: can_connect_to
-      procedure(I_make_extension), deferred :: make_extension
-
       procedure(I_make_adapters), deferred :: make_adapters
 
       procedure(I_add_to_state), deferred :: add_to_state
@@ -127,16 +125,6 @@ subroutine I_allocate(this, rc)
          integer, optional, intent(out) :: rc
       end subroutine I_allocate
 
-      recursive subroutine I_make_extension(this, dst_spec, new_spec, action, rc)
-         use mapl3g_ExtensionAction
-         import StateItemSpec
-         class(StateItemSpec), intent(in) :: this
-         class(StateItemSpec), intent(in) :: dst_spec
-         class(StateItemSpec), allocatable, intent(out) :: new_spec
-         class(ExtensionAction), allocatable, intent(out) :: action
-         integer, optional, intent(out) :: rc
-      end subroutine I_make_extension
-
       subroutine I_add_to_state(this, multi_state, actual_pt, rc)
          use mapl3g_MultiState
          use mapl3g_ActualConnectionPt

diff --git a/generic3g/specs/StateSpec.F90 b/generic3g/specs/StateSpec.F90
@@ -33,8 +33,6 @@ module mapl3g_StateSpec
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
-      procedure :: extension_cost
       procedure :: make_adapters
 
       procedure :: add_to_state
@@ -170,34 +168,6 @@ subroutine add_to_bundle(this, bundle, rc)
    end subroutine add_to_bundle
 
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(StateSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(dst_spec)
-   end subroutine make_extension
-
-   integer function extension_cost(this, src_spec, rc) result(cost)
-      class(StateSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: src_spec
-      integer, optional, intent(out) :: rc
-
-      cost = 0
-
-      _RETURN(_SUCCESS)
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(src_spec)
-   end function extension_cost
-
 
    function make_adapters(this, goal_spec, rc) result(adapters)
       type(StateItemAdapterWrapper), allocatable :: adapters(:)

diff --git a/generic3g/specs/WildcardSpec.F90 b/generic3g/specs/WildcardSpec.F90
@@ -31,7 +31,6 @@ module mapl3g_WildcardSpec
 
       procedure :: connect_to
       procedure :: can_connect_to
-      procedure :: make_extension
       procedure :: make_adapters
       procedure :: add_to_state
       procedure :: add_to_bundle
@@ -198,21 +197,6 @@ subroutine add_to_bundle(this, bundle, rc)
       _RETURN(_SUCCESS)
    end subroutine add_to_bundle
 
-   recursive subroutine make_extension(this, dst_spec, new_spec, action, rc)
-      class(WildcardSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: dst_spec
-      class(StateItemSpec), allocatable, intent(out) :: new_spec
-      class(ExtensionAction), allocatable, intent(out) :: action
-      integer, optional, intent(out) :: rc
-
-      integer :: status
-
-      action = NullAction() ! default
-      new_spec = this
-
-      _FAIL('not implemented')
-   end subroutine make_extension
-
    subroutine set_geometry(this, geom, vertical_grid, rc)
       class(WildcardSpec), intent(inout) :: this
       type(ESMF_Geom), optional, intent(in) :: geom