From da239408a997765a00af200da764d62cbdb54bcc Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 19 Sep 2024 15:10:17 -0400 Subject: [PATCH] Refactor make_extension() With adaptors, we can now implent make_extension() independent of the StateItemSpec subclasses. Reviewed-by: Tom Clune --- generic3g/connection/SimpleConnection.F90 | 34 ---------- generic3g/registry/StateItemExtension.F90 | 18 ++++-- generic3g/specs/BracketSpec.F90 | 16 ----- generic3g/specs/FieldSpec.F90 | 27 -------- generic3g/specs/InvalidSpec.F90 | 31 --------- generic3g/specs/ServiceSpec.F90 | 16 ----- generic3g/specs/StateItemSpec.F90 | 12 ---- generic3g/specs/StateSpec.F90 | 30 --------- generic3g/specs/WildcardSpec.F90 | 16 ----- generic3g/tests/MockItemSpec.F90 | 78 ----------------------- 10 files changed, 12 insertions(+), 266 deletions(-) diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90 index 6fcb4d18e3da..f1e9799fdee3 100644 --- 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 index 7d7f6f7b337a..bb719d060b0a 100644 --- 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 index f9e734c30f51..6d17f4034a64 100644 --- 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 index 3f00f5a59805..3783b472be32 100644 --- 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 index 16bb8eae7a55..2bfd28d47495 100644 --- 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 index 99cee1cc53a0..ed458e4adf3f 100644 --- 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 index 058fec0bcddb..6230d5619a94 100644 --- 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 index ce7bc43e8374..2f8052d5e409 100644 --- 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 index 387582df08ab..0215228d1f74 100644 --- 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 diff --git a/generic3g/tests/MockItemSpec.F90 b/generic3g/tests/MockItemSpec.F90 index 458917e63cfd..b3d865591023 100644 --- a/generic3g/tests/MockItemSpec.F90 +++ b/generic3g/tests/MockItemSpec.F90 @@ -32,8 +32,6 @@ module MockItemSpecMod procedure :: connect_to procedure :: can_connect_to - procedure :: make_extension - procedure :: extension_cost procedure :: make_adapters procedure :: add_to_state procedure :: add_to_bundle @@ -207,82 +205,6 @@ function new_MockAction(src_subtype, dst_subtype) result(action) end if end function new_MockAction - - recursive subroutine make_extension(this, dst_spec, new_spec, action, rc) - class(MockItemSpec), 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 - type(MockItemSpec) :: tmp_spec - - action = NullAction() - new_spec = this - select type(dst_spec) - type is (MockItemSpec) - call make_extension_typesafe(this, dst_spec, tmp_spec, action, _RC) - deallocate(new_spec) - allocate(new_spec, source=tmp_spec) - new_spec = tmp_spec - class default - _FAIL('incompatible spec') - end select - - _RETURN(_SUCCESS) - end subroutine make_extension - - subroutine make_extension_typesafe(this, dst_spec, new_spec, action, rc) - class(MockItemSpec), intent(in) :: this - type(MockItemSpec), intent(in) :: dst_spec - class(MockItemSpec), intent(out) :: new_spec - class(ExtensionAction), allocatable, intent(out) :: action - integer, optional, intent(out) :: rc - - integer :: status - - action = NullAction() - - if (this%name /= dst_spec%name) then - new_spec%name = dst_spec%name - action = MockAction(this%subtype, new_spec%subtype) - _RETURN(_SUCCESS) - end if - - if (allocated(dst_spec%subtype) .and. allocated(this%subtype)) then - if (this%subtype /= dst_spec%subtype) then - new_spec%subtype = dst_spec%subtype - action = MockAction(this%subtype, new_spec%subtype) - _RETURN(_SUCCESS) - end if - end if - - _RETURN(_SUCCESS) - - end subroutine make_extension_typesafe - - integer function extension_cost(this, src_spec, rc) result(cost) - class(MockItemSpec), intent(in) :: this - class(StateItemSpec), intent(in) :: src_spec - integer, optional, intent(out) :: rc - - integer :: status - - cost = 0 - select type(src_spec) - type is (MockItemSpec) - if (this%name /= src_spec%name) cost = cost + 1 - if (allocated(src_spec%subtype) .and. allocated(this%subtype)) then - if (this%subtype /= src_spec%subtype) cost = cost + 1 - end if - class default - _FAIL('incompatible spec') - end select - - _RETURN(_SUCCESS) - end function extension_cost - subroutine initialize(this, importState, exportState, clock, rc) use esmf class(MockAction), intent(inout) :: this