From 0cc113818dcc6bcd20e384800852ef6620a338c9 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 27 Aug 2024 08:57:05 -0400 Subject: [PATCH 1/3] Still refactoring within init phases. --- generic3g/GenericGridComp.F90 | 3 ++ generic3g/GenericPhases.F90 | 3 ++ generic3g/OuterMetaComponent.F90 | 6 ++-- .../initialize_advertise.F90 | 7 ++--- .../initialize_modify_advertise.F90 | 25 +++++++++++++-- generic3g/registry/StateRegistry.F90 | 31 ++++++++++++++++++- generic3g/specs/FieldSpec.F90 | 1 - generic3g/specs/ServiceSpec.F90 | 2 +- generic3g/specs/make_itemSpec.F90 | 2 +- generic3g/tests/CMakeLists.txt | 1 - .../scenarios/service_service/child_A.yaml | 4 +-- .../scenarios/service_service/child_C.yaml | 2 +- 12 files changed, 70 insertions(+), 17 deletions(-) diff --git a/generic3g/GenericGridComp.F90 b/generic3g/GenericGridComp.F90 index 8c616a67451c..b689835d97ac 100644 --- a/generic3g/GenericGridComp.F90 +++ b/generic3g/GenericGridComp.F90 @@ -60,6 +60,7 @@ subroutine set_entry_points(gridcomp, rc) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_ADVERTISE_GEOM, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_ADVERTISE, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISE, _RC) + call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISE2, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_REALIZE, _RC) !# call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_RESTORE, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_USER, _RC) @@ -165,6 +166,8 @@ recursive subroutine initialize(gridcomp, importState, exportState, clock, rc) call outer_meta%initialize_advertise(_RC) case (GENERIC_INIT_MODIFY_ADVERTISE) call outer_meta%initialize_modify_advertise(importState, exportState, clock, _RC) + case (GENERIC_INIT_MODIFY_ADVERTISE2) + call outer_meta%initialize_modify_advertise(importState, exportState, clock, _RC) case (GENERIC_INIT_REALIZE) call outer_meta%initialize_realize(_RC) !# case (GENERIC_INIT_RESTORE) diff --git a/generic3g/GenericPhases.F90 b/generic3g/GenericPhases.F90 index 4d190ce033e1..2741da36ea29 100644 --- a/generic3g/GenericPhases.F90 +++ b/generic3g/GenericPhases.F90 @@ -8,6 +8,7 @@ module mapl3g_GenericPhases public :: GENERIC_INIT_ADVERTISE_GEOM public :: GENERIC_INIT_ADVERTISE public :: GENERIC_INIT_MODIFY_ADVERTISE + public :: GENERIC_INIT_MODIFY_ADVERTISE2 public :: GENERIC_INIT_REALIZE public :: GENERIC_INIT_USER @@ -25,6 +26,7 @@ module mapl3g_GenericPhases enumerator :: GENERIC_INIT_ADVERTISE_GEOM enumerator :: GENERIC_INIT_ADVERTISE enumerator :: GENERIC_INIT_MODIFY_ADVERTISE + enumerator :: GENERIC_INIT_MODIFY_ADVERTISE2 enumerator :: GENERIC_INIT_REALIZE end enum @@ -47,6 +49,7 @@ module mapl3g_GenericPhases GENERIC_INIT_ADVERTISE_GEOM, & GENERIC_INIT_ADVERTISE, & GENERIC_INIT_MODIFY_ADVERTISE, & + GENERIC_INIT_MODIFY_ADVERTISE2, & GENERIC_INIT_REALIZE, & GENERIC_INIT_USER & ] diff --git a/generic3g/OuterMetaComponent.F90 b/generic3g/OuterMetaComponent.F90 index 96b07cbe09ba..7d01bb41eb67 100644 --- a/generic3g/OuterMetaComponent.F90 +++ b/generic3g/OuterMetaComponent.F90 @@ -51,6 +51,8 @@ module mapl3g_OuterMetaComponent type :: OuterMetaComponent private + integer :: subphase = 0 + type(ESMF_GridComp) :: self_gridcomp type(GriddedComponentDriver) :: user_gc_driver class(AbstractUserSetServices), allocatable :: user_setservices @@ -242,14 +244,14 @@ module recursive subroutine initialize_advertise_geom(this, unusable, rc) end subroutine initialize_advertise_geom module recursive subroutine initialize_advertise(this, unusable, rc) - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc end subroutine initialize_advertise module recursive subroutine initialize_modify_advertise(this, importState, exportState, clock, unusable, rc) - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments type(ESMF_State) :: importState type(ESMF_State) :: exportState diff --git a/generic3g/OuterMetaComponent/initialize_advertise.F90 b/generic3g/OuterMetaComponent/initialize_advertise.F90 index 8ffdf34c5f93..f4e63f6feb2e 100644 --- a/generic3g/OuterMetaComponent/initialize_advertise.F90 +++ b/generic3g/OuterMetaComponent/initialize_advertise.F90 @@ -8,7 +8,7 @@ contains module recursive subroutine initialize_advertise(this, unusable, rc) - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -53,7 +53,7 @@ subroutine set_child_geom(this, child_meta, rc) end subroutine set_child_geom subroutine self_advertise(this, unusable, rc) - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -96,8 +96,7 @@ subroutine advertise_variable(var_spec, registry, geom, vertical_grid, unusable, allocate(item_spec, source=make_ItemSpec(var_spec, registry, rc=status)) _VERIFY(status) call item_spec%create(_RC) - call item_spec%initialize(geom, vertical_grid, _RC) - +!# call item_spec%initialize(geom, vertical_grid, _RC) virtual_pt = var_spec%make_virtualPt() call registry%add_primary_spec(virtual_pt, item_spec) diff --git a/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 b/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 index 1513ffe91749..a43de4ac18aa 100644 --- a/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 +++ b/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 @@ -6,7 +6,7 @@ contains module recursive subroutine initialize_modify_advertise(this, importState, exportState, clock, unusable, rc) - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments type(ESMF_State) :: importState type(ESMF_State) :: exportState @@ -18,22 +18,41 @@ module recursive subroutine initialize_modify_advertise(this, importState, expor character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_MODIFY_ADVERTISE' type(MultiState) :: outer_states, user_states + if (this%subphase == 0) then + call self_advertise(this, _RC) + call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISE, _RC) + this%subphase = 1 - this%subphase + _RETURN(_SUCCESS) + end if + call this%run_custom(ESMF_METHOD_INITIALIZE, PHASE_NAME, _RC) call process_connections(this, _RC) call this%registry%propagate_exports(_RC) user_states = this%user_gc_driver%get_states() call this%registry%add_to_states(user_states, mode='user', _RC) - outer_states = MultiState(importState=importState, exportState=exportState) call this%registry%add_to_states(outer_states, mode='outer', _RC) - call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISE, _RC) + this%subphase = 1 - this%subphase _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine initialize_modify_advertise + subroutine self_advertise(this, unusable, rc) + class(OuterMetaComponent), target, intent(inout) :: this + class(KE), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status + + call this%registry%initialize_specs(this%geom, this%vertical_grid, _RC) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + end subroutine self_advertise + subroutine process_connections(this, rc) class(OuterMetaComponent), intent(inout) :: this integer, optional, intent(out) :: rc diff --git a/generic3g/registry/StateRegistry.F90 b/generic3g/registry/StateRegistry.F90 index 3cb6ac961e9c..e2c9ec1ee3e6 100644 --- a/generic3g/registry/StateRegistry.F90 +++ b/generic3g/registry/StateRegistry.F90 @@ -19,7 +19,9 @@ module mapl3g_StateRegistry use mapl3g_ComponentDriverVector use mapl3g_ComponentDriverPtrVector use mapl3g_GriddedComponentDriver + use mapl3g_VerticalGrid use mapl_ErrorHandling + use esmf, only: ESMF_Geom implicit none private @@ -74,7 +76,9 @@ module mapl3g_StateRegistry generic :: get_subregistry => get_subregistry_by_name generic :: get_subregistry => get_subregistry_by_conn_pt + ! Actions on specs procedure :: allocate + procedure :: initialize_specs procedure :: add_to_states procedure :: filter ! for MatchConnection @@ -191,6 +195,7 @@ function get_primary_extension(this, virtual_pt, rc) result(primary) family => this%family_map%at(virtual_pt,_RC) primary => family%get_primary() + _RETURN(_SUCCESS) end function get_primary_extension @@ -488,7 +493,7 @@ subroutine propagate_exports_virtual_pt(this, subregistry_name, iter, rc) type(VirtualConnectionPt), pointer :: virtual_pt type(VirtualConnectionPt) :: new_virtual_pt type(ExtensionFamily), pointer :: family - integer :: n +!# integer :: n type(VirtualPtFamilyMapIterator) :: new_iter virtual_pt => iter%first() @@ -611,6 +616,30 @@ subroutine allocate(this, rc) _RETURN(_SUCCESS) end subroutine allocate + subroutine initialize_specs(this, geom, vertical_grid, rc) + class(StateRegistry), target, intent(inout) :: this + type(ESMF_Geom), optional, intent(in) :: geom + class(VerticalGrid), optional, intent(in) :: vertical_grid + integer, optional, intent(out) :: rc + + integer :: status + type(StateItemExtensionVectorIterator) :: iter + class(StateItemExtension), pointer :: extension + class(StateItemSpec), pointer :: spec + + associate (e => this%owned_items%ftn_end()) + iter = this%owned_items%ftn_begin() + do while (iter /= e) + call iter%next() + extension => iter%of() + spec => extension%get_spec() + call spec%initialize(geom, vertical_grid, _RC) + end do + end associate + + _RETURN(_SUCCESS) + end subroutine initialize_specs + subroutine add_to_states(this, multi_state, mode, rc) use esmf use mapl3g_MultiState diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index 9a1a099d090c..f0568fe87a3e 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -728,7 +728,6 @@ subroutine make_extension_safely(this, dst_spec, new_spec, action, rc) _ASSERT(allocated(this%vertical_grid), 'Source spec must specify a valid vertical grid.') if (.not. same_vertical_grid(this%vertical_grid, dst_spec%vertical_grid)) then - _HERE call this%vertical_grid%get_coordinate_field(v_in_coord, v_in_coupler, & 'ignore', this%geom, this%typekind, this%units, _RC) call this%vertical_grid%get_coordinate_field(v_out_coord, v_out_coupler, & diff --git a/generic3g/specs/ServiceSpec.F90 b/generic3g/specs/ServiceSpec.F90 index bad70be7fc82..cd87af3188b1 100644 --- a/generic3g/specs/ServiceSpec.F90 +++ b/generic3g/specs/ServiceSpec.F90 @@ -57,7 +57,7 @@ module mapl3g_ServiceSpec function new_ServiceSpec(variable_spec, registry) result(spec) type(ServiceSpec) :: spec type(VariableSpec), intent(in) :: variable_spec - type(StateRegistry), target, intent(in) :: registry + type(StateRegistry), pointer, intent(in) :: registry spec%variable_spec = variable_spec spec%registry => registry diff --git a/generic3g/specs/make_itemSpec.F90 b/generic3g/specs/make_itemSpec.F90 index 920eff00c930..3f049e14d6f2 100644 --- a/generic3g/specs/make_itemSpec.F90 +++ b/generic3g/specs/make_itemSpec.F90 @@ -21,7 +21,7 @@ function make_itemSpec(variable_spec, registry, rc) result(item_spec) use mapl3g_VariableSpec, only: VariableSpec class(StateItemSpec), allocatable :: item_spec class(VariableSpec), intent(in) :: variable_spec - type(StateRegistry), target, intent(in) :: registry + type(StateRegistry), pointer, intent(in) :: registry integer, optional, intent(out) :: rc integer :: status diff --git a/generic3g/tests/CMakeLists.txt b/generic3g/tests/CMakeLists.txt index 1e6c58e77c73..a090ab068e6b 100644 --- a/generic3g/tests/CMakeLists.txt +++ b/generic3g/tests/CMakeLists.txt @@ -5,7 +5,6 @@ add_library(scratchpad SHARED scratchpad.F90) add_subdirectory(gridcomps) set (test_srcs -# Test_AddVarSpec.pf Test_VirtualConnectionPt.pf diff --git a/generic3g/tests/scenarios/service_service/child_A.yaml b/generic3g/tests/scenarios/service_service/child_A.yaml index 03f664a1879a..ec0049b6e0ab 100644 --- a/generic3g/tests/scenarios/service_service/child_A.yaml +++ b/generic3g/tests/scenarios/service_service/child_A.yaml @@ -2,11 +2,11 @@ mapl: states: internal: Z_A1: - standard_name: 'Z_A1 standard name' + standard_name: 'Z_A1 standard name' units: 'meter' vertical_dim_spec: NONE Z_A2: - standard_name: 'Z_A2 standard name' + standard_name: 'Z_A2 standard name' units: 'meter' vertical_dim_spec: NONE diff --git a/generic3g/tests/scenarios/service_service/child_C.yaml b/generic3g/tests/scenarios/service_service/child_C.yaml index b28c9ab334c9..d89399c00370 100644 --- a/generic3g/tests/scenarios/service_service/child_C.yaml +++ b/generic3g/tests/scenarios/service_service/child_C.yaml @@ -2,7 +2,7 @@ mapl: states: internal: W: - standard_name: 'W standard name' + standard_name: 'W standard name' units: 'meter' vertical_dim_spec: NONE From 7bcbbabe47d77c024129e0469e736e2ba901494e Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 27 Aug 2024 09:07:46 -0400 Subject: [PATCH 2/3] Eliminated "geom" phases in MAPL3. To achieve this: 1. Work in geom phases was spread across advertise and modify_advertised phases. 2. modify_advertised was split into 2 MAPL3 phases. 3. Some subtle work was done to enable extdata_1 scenario to still function. This use case will probably be tossed in favor of a different approach for ExtData. --- generic3g/CMakeLists.txt | 4 +- generic3g/GenericGridComp.F90 | 15 +- generic3g/GenericPhases.F90 | 14 +- generic3g/OuterMetaComponent.F90 | 21 ++- .../initialize_advertise.F90 | 51 ++--- .../initialize_advertise_geom.F90 | 60 ------ .../initialize_modify_advertised.F90 | 89 +++++++++ ....F90 => initialize_modify_advertised2.F90} | 21 +-- generic3g/connection/SimpleConnection.F90 | 15 +- generic3g/registry/StateRegistry.F90 | 18 +- generic3g/specs/FieldSpec.F90 | 83 ++++---- generic3g/specs/VariableSpec.F90 | 177 ------------------ generic3g/specs/make_itemSpec.F90 | 11 ++ generic3g/tests/Test_Scenarios.pf | 5 +- generic3g/tests/gridcomps/ProtoExtDataGC.F90 | 110 +++++++++-- .../scenarios/export_dependency/child_A.yaml | 6 +- .../scenarios/export_dependency/child_B.yaml | 3 +- .../scenarios/extdata_1/collection_1.yaml | 2 +- .../scenarios/extdata_1/expectations.yaml | 5 +- generic3g/vertical/BasicVerticalGrid.F90 | 1 + .../vertical/FixedLevelsVerticalGrid.F90 | 1 + generic3g/vertical/ModelVerticalGrid.F90 | 1 + 22 files changed, 343 insertions(+), 370 deletions(-) delete mode 100644 generic3g/OuterMetaComponent/initialize_advertise_geom.F90 create mode 100644 generic3g/OuterMetaComponent/initialize_modify_advertised.F90 rename generic3g/OuterMetaComponent/{initialize_modify_advertise.F90 => initialize_modify_advertised2.F90} (79%) diff --git a/generic3g/CMakeLists.txt b/generic3g/CMakeLists.txt index b1d76be24b85..691d267b9e2f 100644 --- a/generic3g/CMakeLists.txt +++ b/generic3g/CMakeLists.txt @@ -72,8 +72,8 @@ esma_add_fortran_submodules( get_child_by_name.F90 run_child_by_name.F90 run_children.F90 get_outer_meta_from_outer_gc.F90 attach_outer_meta.F90 free_outer_meta.F90 get_phases.F90 set_hconfig.F90 get_hconfig.F90 get_geom.F90 - initialize_advertise_geom.F90 - initialize_advertise.F90 initialize_modify_advertise.F90 + initialize_advertise.F90 + initialize_modify_advertised.F90 initialize_modify_advertised2.F90 initialize_realize.F90 recurse.F90 apply_to_children_custom.F90 initialize_user.F90 run_custom.F90 run_user.F90 run_clock_advance.F90 read_restart.F90 write_restart.F90 get_name.F90 get_gridcomp.F90 diff --git a/generic3g/GenericGridComp.F90 b/generic3g/GenericGridComp.F90 index b689835d97ac..b1b45649ab15 100644 --- a/generic3g/GenericGridComp.F90 +++ b/generic3g/GenericGridComp.F90 @@ -57,10 +57,9 @@ subroutine set_entry_points(gridcomp, rc) integer, parameter :: NUM_GENERIC_RUN_PHASES = 1 ! Mandatory generic initialize phases - call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_ADVERTISE_GEOM, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_ADVERTISE, _RC) - call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISE, _RC) - call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISE2, _RC) + call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISED, _RC) + call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_MODIFY_ADVERTISED2, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_REALIZE, _RC) !# call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_RESTORE, _RC) call ESMF_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, initialize, phase=GENERIC_INIT_USER, _RC) @@ -160,14 +159,12 @@ recursive subroutine initialize(gridcomp, importState, exportState, clock, rc) outer_meta => get_outer_meta(gridcomp, _RC) call ESMF_GridCompGet(gridcomp, currentPhase=phase, _RC) select case (phase) - case (GENERIC_INIT_ADVERTISE_GEOM) - call outer_meta%initialize_advertise_geom(_RC) case (GENERIC_INIT_ADVERTISE) call outer_meta%initialize_advertise(_RC) - case (GENERIC_INIT_MODIFY_ADVERTISE) - call outer_meta%initialize_modify_advertise(importState, exportState, clock, _RC) - case (GENERIC_INIT_MODIFY_ADVERTISE2) - call outer_meta%initialize_modify_advertise(importState, exportState, clock, _RC) + case (GENERIC_INIT_MODIFY_ADVERTISED) + call outer_meta%initialize_modify_advertised(importState, exportState, clock, _RC) + case (GENERIC_INIT_MODIFY_ADVERTISED2) + call outer_meta%initialize_modify_advertised2(importState, exportState, clock, _RC) case (GENERIC_INIT_REALIZE) call outer_meta%initialize_realize(_RC) !# case (GENERIC_INIT_RESTORE) diff --git a/generic3g/GenericPhases.F90 b/generic3g/GenericPhases.F90 index 2741da36ea29..2c906803092a 100644 --- a/generic3g/GenericPhases.F90 +++ b/generic3g/GenericPhases.F90 @@ -5,10 +5,9 @@ module mapl3g_GenericPhases ! Named constants ! Init phases public :: GENERIC_INIT_PHASE_SEQUENCE - public :: GENERIC_INIT_ADVERTISE_GEOM public :: GENERIC_INIT_ADVERTISE - public :: GENERIC_INIT_MODIFY_ADVERTISE - public :: GENERIC_INIT_MODIFY_ADVERTISE2 + public :: GENERIC_INIT_MODIFY_ADVERTISED + public :: GENERIC_INIT_MODIFY_ADVERTISED2 public :: GENERIC_INIT_REALIZE public :: GENERIC_INIT_USER @@ -25,8 +24,8 @@ module mapl3g_GenericPhases enumerator :: GENERIC_INIT_USER = 1 enumerator :: GENERIC_INIT_ADVERTISE_GEOM enumerator :: GENERIC_INIT_ADVERTISE - enumerator :: GENERIC_INIT_MODIFY_ADVERTISE - enumerator :: GENERIC_INIT_MODIFY_ADVERTISE2 + enumerator :: GENERIC_INIT_MODIFY_ADVERTISED + enumerator :: GENERIC_INIT_MODIFY_ADVERTISED2 enumerator :: GENERIC_INIT_REALIZE end enum @@ -46,10 +45,9 @@ module mapl3g_GenericPhases integer, parameter :: GENERIC_INIT_PHASE_SEQUENCE(*) = & [ & - GENERIC_INIT_ADVERTISE_GEOM, & GENERIC_INIT_ADVERTISE, & - GENERIC_INIT_MODIFY_ADVERTISE, & - GENERIC_INIT_MODIFY_ADVERTISE2, & + GENERIC_INIT_MODIFY_ADVERTISED, & + GENERIC_INIT_MODIFY_ADVERTISED2, & GENERIC_INIT_REALIZE, & GENERIC_INIT_USER & ] diff --git a/generic3g/OuterMetaComponent.F90 b/generic3g/OuterMetaComponent.F90 index 7d01bb41eb67..3a959f27a071 100644 --- a/generic3g/OuterMetaComponent.F90 +++ b/generic3g/OuterMetaComponent.F90 @@ -51,8 +51,6 @@ module mapl3g_OuterMetaComponent type :: OuterMetaComponent private - integer :: subphase = 0 - type(ESMF_GridComp) :: self_gridcomp type(GriddedComponentDriver) :: user_gc_driver class(AbstractUserSetServices), allocatable :: user_setservices @@ -92,9 +90,9 @@ module mapl3g_OuterMetaComponent procedure :: run_custom procedure :: initialize_user - procedure :: initialize_advertise_geom procedure :: initialize_advertise - procedure :: initialize_modify_advertise + procedure :: initialize_modify_advertised + procedure :: initialize_modify_advertised2 procedure :: initialize_realize procedure :: run_user @@ -236,21 +234,24 @@ module function get_geom(this) result(geom) class(OuterMetaComponent), intent(inout) :: this end function get_geom - module recursive subroutine initialize_advertise_geom(this, unusable, rc) + module recursive subroutine initialize_advertise(this, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - end subroutine initialize_advertise_geom + end subroutine initialize_advertise - module recursive subroutine initialize_advertise(this, unusable, rc) + module recursive subroutine initialize_modify_advertised(this, importState, exportState, clock, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - end subroutine initialize_advertise + end subroutine initialize_modify_advertised - module recursive subroutine initialize_modify_advertise(this, importState, exportState, clock, unusable, rc) + module recursive subroutine initialize_modify_advertised2(this, importState, exportState, clock, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments type(ESMF_State) :: importState @@ -258,7 +259,7 @@ module recursive subroutine initialize_modify_advertise(this, importState, expor type(ESMF_Clock) :: clock class(KE), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - end subroutine initialize_modify_advertise + end subroutine initialize_modify_advertised2 module recursive subroutine initialize_realize(this, unusable, rc) class(OuterMetaComponent), intent(inout) :: this diff --git a/generic3g/OuterMetaComponent/initialize_advertise.F90 b/generic3g/OuterMetaComponent/initialize_advertise.F90 index f4e63f6feb2e..00e39baa291d 100644 --- a/generic3g/OuterMetaComponent/initialize_advertise.F90 +++ b/generic3g/OuterMetaComponent/initialize_advertise.F90 @@ -14,15 +14,39 @@ module recursive subroutine initialize_advertise(this, unusable, rc) integer, optional, intent(out) :: rc integer :: status + class(GriddedComponentDriver), pointer :: provider + type(ESMF_GridComp) :: provider_gc + type(OuterMetaComponent), pointer :: provider_meta + type(MaplGeom), pointer :: mapl_geom + type(GeomManager), pointer :: geom_mgr character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_ADVERTISE' - call apply_to_children(this, set_child_geom, _RC) - - call this%run_custom(ESMF_METHOD_INITIALIZE, PHASE_NAME, _RC) call self_advertise(this, _RC) + + associate (geometry_spec => this%component_spec%geometry_spec) + if (allocated(geometry_spec%geom_spec)) then + geom_mgr => get_geom_manager() + mapl_geom => geom_mgr%get_mapl_geom(geometry_spec%geom_spec, _RC) + this%geom = mapl_geom%get_geom() + end if + if (allocated(geometry_spec%vertical_grid)) then + this%vertical_grid = geometry_spec%vertical_grid + end if + end associate + call recurse(this, phase_idx=GENERIC_INIT_ADVERTISE, _RC) + associate (geometry_spec => this%component_spec%geometry_spec) + if (geometry_spec%kind == GEOMETRY_FROM_CHILD) then + provider => this%children%at(geometry_spec%provider, _RC) + provider_gc = provider%get_gridcomp() + provider_meta => get_outer_meta(provider_gc, _RC) + _ASSERT(allocated(provider_meta%geom), 'Specified child does not provide a geom.') + this%geom = provider_meta%geom + end if + end associate + call process_connections(this, _RC) call this%registry%propagate_unsatisfied_imports(_RC) call this%registry%propagate_exports(_RC) @@ -31,27 +55,6 @@ module recursive subroutine initialize_advertise(this, unusable, rc) _UNUSED_DUMMY(unusable) contains - subroutine set_child_geom(this, child_meta, rc) - class(OuterMetaComponent), target, intent(inout) :: this - type(OuterMetaComponent), target, intent(inout) :: child_meta - integer, optional, intent(out) :: rc - - integer :: status - - associate(kind => child_meta%component_spec%geometry_spec%kind) - _RETURN_IF(kind /= GEOMETRY_FROM_PARENT) - - if (allocated(this%geom)) then - call child_meta%set_geom(this%geom) - end if - if (allocated(this%vertical_grid)) then - call child_meta%set_vertical_grid(this%vertical_grid) - end if - end associate - - _RETURN(ESMF_SUCCESS) - end subroutine set_child_geom - subroutine self_advertise(this, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this class(KE), optional, intent(in) :: unusable diff --git a/generic3g/OuterMetaComponent/initialize_advertise_geom.F90 b/generic3g/OuterMetaComponent/initialize_advertise_geom.F90 deleted file mode 100644 index 8cbf0d2d99e7..000000000000 --- a/generic3g/OuterMetaComponent/initialize_advertise_geom.F90 +++ /dev/null @@ -1,60 +0,0 @@ -#include "MAPL_Generic.h" - -submodule (mapl3g_OuterMetaComponent) initialize_advertise_geom_smod - implicit none - -contains - - ! ESMF initialize methods - - !---------- - !The parent geom can be overridden by a - ! component by: - ! - providing a geom spec in the generic section of its config - ! file, or - ! - specifying an INIT_GEOM phase - ! If both are specified, the INIT_GEOM overrides the config spec. - !---------- - module recursive subroutine initialize_advertise_geom(this, unusable, rc) - class(OuterMetaComponent), target, intent(inout) :: this - ! optional arguments - class(KE), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status - type(MaplGeom), pointer :: mapl_geom - character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_ADVERTISE_GEOM' - type(GeomManager), pointer :: geom_mgr - class(GriddedComponentDriver), pointer :: provider - type(ESMF_GridComp) :: provider_gc - type(OuterMetaComponent), pointer :: provider_meta - - associate (geometry_spec => this%component_spec%geometry_spec) - if (allocated(geometry_spec%geom_spec)) then - geom_mgr => get_geom_manager() - mapl_geom => geom_mgr%get_mapl_geom(geometry_spec%geom_spec, _RC) - this%geom = mapl_geom%get_geom() - end if - if (allocated(geometry_spec%vertical_grid)) then - this%vertical_grid = geometry_spec%vertical_grid - end if - - call this%run_custom(ESMF_METHOD_INITIALIZE, PHASE_NAME, _RC) - - call recurse(this, phase_idx=GENERIC_INIT_ADVERTISE_GEOM, _RC) - - if (geometry_spec%kind == GEOMETRY_FROM_CHILD) then - provider => this%children%at(geometry_spec%provider, _RC) - provider_gc = provider%get_gridcomp() - provider_meta => get_outer_meta(provider_gc, _RC) - _ASSERT(allocated(provider_meta%geom), 'Specified child does not provide a geom.') - this%geom = provider_meta%geom - end if - end associate - - _RETURN(ESMF_SUCCESS) - contains - - end subroutine initialize_advertise_geom - -end submodule initialize_advertise_geom_smod diff --git a/generic3g/OuterMetaComponent/initialize_modify_advertised.F90 b/generic3g/OuterMetaComponent/initialize_modify_advertised.F90 new file mode 100644 index 000000000000..d4e69bc9d812 --- /dev/null +++ b/generic3g/OuterMetaComponent/initialize_modify_advertised.F90 @@ -0,0 +1,89 @@ +#include "MAPL_Generic.h" + +submodule (mapl3g_OuterMetaComponent) initialize_modify_advertised_smod + implicit none + +contains + + module recursive subroutine initialize_modify_advertised(this, importState, exportState, clock, unusable, rc) + class(OuterMetaComponent), target, intent(inout) :: this + ! optional arguments + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + class(KE), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status + character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_MODIFY_ADVERTISED' + type(MultiState) :: outer_states, user_states + + call apply_to_children(this, set_child_geom, _RC) + call this%run_custom(ESMF_METHOD_INITIALIZE, PHASE_NAME, _RC) + call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISED, _RC) + + call self_advertise(this, _RC) + call process_connections(this, _RC) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + contains + + subroutine set_child_geom(this, child_meta, rc) + class(OuterMetaComponent), target, intent(inout) :: this + type(OuterMetaComponent), target, intent(inout) :: child_meta + integer, optional, intent(out) :: rc + + integer :: status + + associate(kind => child_meta%component_spec%geometry_spec%kind) + _RETURN_IF(kind /= GEOMETRY_FROM_PARENT) + + if (allocated(this%geom)) then + call child_meta%set_geom(this%geom) + end if + if (allocated(this%vertical_grid)) then + call child_meta%set_vertical_grid(this%vertical_grid) + end if + end associate + + _RETURN(ESMF_SUCCESS) + end subroutine set_child_geom + + end subroutine initialize_modify_advertised + + + subroutine self_advertise(this, unusable, rc) + class(OuterMetaComponent), target, intent(inout) :: this + class(KE), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status + + call this%registry%initialize_specs(this%geom, this%vertical_grid, _RC) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + end subroutine self_advertise + + subroutine process_connections(this, rc) + class(OuterMetaComponent), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + type(ConnectionVectorIterator) :: iter + class(Connection), pointer :: c + + associate (e => this%component_spec%connections%end()) + iter = this%component_spec%connections%begin() + do while (iter /= e) + c => iter%of() + call c%connect(this%registry, _RC) + call iter%next() + end do + end associate + + _RETURN(_SUCCESS) + end subroutine process_connections + +end submodule initialize_modify_advertised_smod diff --git a/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 b/generic3g/OuterMetaComponent/initialize_modify_advertised2.F90 similarity index 79% rename from generic3g/OuterMetaComponent/initialize_modify_advertise.F90 rename to generic3g/OuterMetaComponent/initialize_modify_advertised2.F90 index a43de4ac18aa..ce336ac989f1 100644 --- a/generic3g/OuterMetaComponent/initialize_modify_advertise.F90 +++ b/generic3g/OuterMetaComponent/initialize_modify_advertised2.F90 @@ -1,11 +1,11 @@ #include "MAPL_Generic.h" -submodule (mapl3g_OuterMetaComponent) initialize_modify_advertise_smod +submodule (mapl3g_OuterMetaComponent) initialize_modify_advertised2_smod implicit none contains - module recursive subroutine initialize_modify_advertise(this, importState, exportState, clock, unusable, rc) + module recursive subroutine initialize_modify_advertised2(this, importState, exportState, clock, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this ! optional arguments type(ESMF_State) :: importState @@ -15,30 +15,21 @@ module recursive subroutine initialize_modify_advertise(this, importState, expor integer, optional, intent(out) :: rc integer :: status - character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_MODIFY_ADVERTISE' + character(*), parameter :: PHASE_NAME = 'GENERIC::INIT_MODIFY_ADVERTISED2' type(MultiState) :: outer_states, user_states - if (this%subphase == 0) then - call self_advertise(this, _RC) - call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISE, _RC) - this%subphase = 1 - this%subphase - _RETURN(_SUCCESS) - end if - call this%run_custom(ESMF_METHOD_INITIALIZE, PHASE_NAME, _RC) - call process_connections(this, _RC) call this%registry%propagate_exports(_RC) + call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISED2, _RC) user_states = this%user_gc_driver%get_states() call this%registry%add_to_states(user_states, mode='user', _RC) outer_states = MultiState(importState=importState, exportState=exportState) call this%registry%add_to_states(outer_states, mode='outer', _RC) - call recurse(this, phase_idx=GENERIC_INIT_MODIFY_ADVERTISE, _RC) - this%subphase = 1 - this%subphase _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) - end subroutine initialize_modify_advertise + end subroutine initialize_modify_advertised2 subroutine self_advertise(this, unusable, rc) class(OuterMetaComponent), target, intent(inout) :: this @@ -73,4 +64,4 @@ subroutine process_connections(this, rc) _RETURN(_SUCCESS) end subroutine process_connections -end submodule initialize_modify_advertise_smod +end submodule initialize_modify_advertised2_smod diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90 index 6cee529bb14b..3de924aff20f 100644 --- a/generic3g/connection/SimpleConnection.F90 +++ b/generic3g/connection/SimpleConnection.F90 @@ -99,6 +99,7 @@ recursive subroutine activate(this, registry, rc) src_extension => src_extensions(i)%ptr spec => src_extension%get_spec() call spec%set_active() + call activate_dependencies(src_extension, src_registry, _RC) end do _RETURN(_SUCCESS) @@ -164,27 +165,33 @@ recursive subroutine connect_sibling(this, dst_registry, src_registry, unusable, dst_pt = this%get_destination() dst_extensions = dst_registry%get_extensions(dst_pt%v_pt, _RC) - src_extensions = src_registry%get_extensions(src_pt%v_pt, _RC) do i = 1, size(dst_extensions) dst_extension => dst_extensions(i)%ptr dst_spec => dst_extension%get_spec() + src_extensions = src_registry%get_extensions(src_pt%v_pt, _RC) + + ! Connection is transitive -- if any src_specs can connect, all can connect. ! So we can just check this property on the 1st item. src_extension => src_extensions(1)%ptr src_spec => src_extension%get_spec() - _ASSERT(dst_spec%can_connect_to(src_spec), "impossible connection") + if (.not. dst_spec%can_connect_to(src_spec)) then + _HERE, 'cannot connect: ', src_pt%v_pt, ' --> ', dst_pt%v_pt + end if call find_closest_extension(dst_extension, src_extensions, closest_extension=best_extension, lowest_cost=lowest_cost, _RC) best_spec => best_extension%get_spec() call best_spec%set_active() - call activate_dependencies(best_extension, src_registry, _RC) last_extension => best_extension + do i_extension = 1, lowest_cost + extension = last_extension%make_extension(dst_spec, _RC) + new_extension => src_registry%add_extension(src_pt%v_pt, extension, _RC) coupler => new_extension%get_producer() @@ -270,7 +277,7 @@ subroutine find_closest_extension(goal_extension, candidate_extensions, closest_ if (lowest_cost == 0) exit extension => candidate_extensions(j)%ptr - spec => closest_extension%get_spec() + spec => extension%get_spec() cost = goal_spec%extension_cost(spec) if (cost < lowest_cost) then lowest_cost = cost diff --git a/generic3g/registry/StateRegistry.F90 b/generic3g/registry/StateRegistry.F90 index e2c9ec1ee3e6..b7cbad9e3722 100644 --- a/generic3g/registry/StateRegistry.F90 +++ b/generic3g/registry/StateRegistry.F90 @@ -430,7 +430,7 @@ subroutine link(extension, rc) spec => extension%get_spec() _RETURN_IF(spec%is_active()) - + if (.not. this%has_virtual_pt(virtual_pt)) then call this%add_virtual_pt(virtual_pt, _RC) end if @@ -575,6 +575,9 @@ subroutine write_virtual_pts(this, iostat, iomsg) type(VirtualPtFamilyMapIterator) :: virtual_iter type(ExtensionFamily), pointer :: family + type(StateItemExtension), pointer :: extension + class(StateItemSpec), pointer :: spec + logical :: is_active write(unit,*,iostat=iostat,iomsg=iomsg) ' virtuals: '// new_line('a') if (iostat /= 0) return @@ -584,9 +587,15 @@ subroutine write_virtual_pts(this, iostat, iomsg) call virtual_iter%next() associate (virtual_pt => virtual_iter%first()) family => virtual_iter%second() + is_active = .false. + if (family%has_primary()) then + extension => family%get_primary() + spec => extension%get_spec() + is_active = spec%is_active() + end if write(unit,*,iostat=iostat,iomsg=iomsg)' ',virtual_pt, & ': ',family%num_variants(), ' variants ', & - ' is primary? ', family%has_primary(), new_line('a') + ' is primary? ', family%has_primary(), ' is active? ', is_active, new_line('a') if (iostat /= 0) return end associate end do @@ -633,7 +642,9 @@ subroutine initialize_specs(this, geom, vertical_grid, rc) call iter%next() extension => iter%of() spec => extension%get_spec() - call spec%initialize(geom, vertical_grid, _RC) + if (spec%is_active()) then + call spec%initialize(geom, vertical_grid, _RC) + end if end do end associate @@ -694,7 +705,6 @@ subroutine add_to_states(this, multi_state, mode, rc) a_pt = ActualConnectionPt(v_pt) if (label /= 0) a_pt = ActualConnectionPt(v_pt, label=label) - call spec%add_to_state(multi_state, a_pt, _RC) end do end associate diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index f0568fe87a3e..918538824c24 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -68,7 +68,7 @@ module mapl3g_FieldSpec type, extends(StateItemSpec) :: FieldSpec - private +!# private type(ESMF_Geom), allocatable :: geom class(VerticalGrid), allocatable :: vertical_grid type(VerticalDimSpec) :: vertical_dim_spec = VERTICAL_DIM_UNKNOWN @@ -88,7 +88,7 @@ module mapl3g_FieldSpec type(ESMF_Field) :: payload real, allocatable :: default_value - type(VariableSpec) :: variable_spec +!# type(VariableSpec) :: variable_spec logical :: is_created = .false. @@ -193,10 +193,22 @@ function new_FieldSpec_varspec(variable_spec) result(field_spec) type(FieldSpec) :: field_spec class(VariableSpec), intent(in) :: variable_spec - field_spec%variable_spec = variable_spec - field_spec%long_name = ' ' - !wdb fixme deleteme long_name is set here based on the VariableSpec - ! make_FieldSpec method + type(ESMF_RegridMethod_Flag), allocatable :: regrid_method + + _SET_FIELD(field_spec, variable_spec, vertical_dim_spec) + _SET_FIELD(field_spec, variable_spec, typekind) + _SET_FIELD(field_spec, variable_spec, ungridded_dims) + _SET_FIELD(field_spec, variable_spec, attributes) + _SET_ALLOCATED_FIELD(field_spec, variable_spec, standard_name) + _SET_ALLOCATED_FIELD(field_spec, variable_spec, units) + _SET_ALLOCATED_FIELD(field_spec, variable_spec, default_value) + + field_spec%long_name = 'unknown' + + field_spec%regrid_param = EsmfRegridderParam() ! use default regrid method + regrid_method = get_regrid_method_(field_spec%standard_name) + field_spec%regrid_param = EsmfRegridderParam(regridmethod=regrid_method) + end function new_FieldSpec_varspec @@ -229,33 +241,22 @@ subroutine initialize_field_spec(this, geom, vertical_grid, rc) integer, optional, intent(out) :: rc integer :: status type(ESMF_RegridMethod_Flag), allocatable :: regrid_method - type(ActualPtVector) :: dependencies - - associate (variable_spec => this%variable_spec) - if (present(geom)) this%geom = geom - if (present(vertical_grid)) this%vertical_grid = vertical_grid - - _SET_FIELD(this, variable_spec, vertical_dim_spec) - _SET_FIELD(this, variable_spec, typekind) - _SET_FIELD(this, variable_spec, ungridded_dims) - _SET_FIELD(this, variable_spec, attributes) - _SET_ALLOCATED_FIELD(this, variable_spec, standard_name) - _SET_ALLOCATED_FIELD(this, variable_spec, units) - _SET_ALLOCATED_FIELD(this, variable_spec, default_value) - - this%regrid_param = EsmfRegridderParam() ! use default regrid method - regrid_method = get_regrid_method_(this%standard_name) - this%regrid_param = EsmfRegridderParam(regridmethod=regrid_method) - - dependencies = variable_spec%make_dependencies(_RC) - call this%set_dependencies(dependencies) - call this%set_raw_dependencies(variable_spec%dependencies) - - if (variable_spec%state_intent == ESMF_STATEINTENT_INTERNAL) then - call this%set_active() - end if - end associate + if (present(geom)) this%geom = geom + if (present(vertical_grid)) this%vertical_grid = vertical_grid + +!# _SET_FIELD(this, variable_spec, vertical_dim_spec) +!# _SET_FIELD(this, variable_spec, typekind) +!# _SET_FIELD(this, variable_spec, ungridded_dims) +!# _SET_FIELD(this, variable_spec, attributes) +!# _SET_ALLOCATED_FIELD(this, variable_spec, standard_name) +!# _SET_ALLOCATED_FIELD(this, variable_spec, units) +!# _SET_ALLOCATED_FIELD(this, variable_spec, default_value) +!# +!# this%regrid_param = EsmfRegridderParam() ! use default regrid method +!# regrid_method = get_regrid_method_(this%standard_name) +!# this%regrid_param = EsmfRegridderParam(regridmethod=regrid_method) + _RETURN(_SUCCESS) end subroutine initialize_field_spec @@ -778,7 +779,21 @@ logical function same_vertical_grid(src_grid, dst_grid) if (.not. allocated(dst_grid)) return ! mirror geom same_vertical_grid = src_grid%same_id(dst_grid) - + + block + use mapl3g_BasicVerticalGrid + ! "temporary kludge" while true vertical grid logic is being implemented + if (.not. same_vertical_grid) then + select type(src_grid) + type is (BasicVerticalGrid) + select type (dst_grid) + type is (BasicVerticalGrid) + same_vertical_grid = (src_grid%get_num_levels() == dst_grid%get_num_levels()) + end select + end select + end if + end block + end function same_vertical_grid logical function same_units(src_units, dst_units) @@ -1022,7 +1037,7 @@ subroutine set_info(this, field, rc) _RETURN(_SUCCESS) end subroutine set_info - + end module mapl3g_FieldSpec #undef _SET_FIELD #undef _SET_ALLOCATED_FIELD diff --git a/generic3g/specs/VariableSpec.F90 b/generic3g/specs/VariableSpec.F90 index 802887aae3b0..8b8303b74175 100644 --- a/generic3g/specs/VariableSpec.F90 +++ b/generic3g/specs/VariableSpec.F90 @@ -51,19 +51,9 @@ module mapl3g_VariableSpec type(StringVector) :: dependencies contains procedure :: make_virtualPt - !wdb fixme deleteme These are obsolete because StateItemSpec is performing these actions -! procedure :: make_ItemSpec_new -! generic :: make_itemSpec => make_itemSpec_new -! procedure :: make_BracketSpec -! procedure :: make_FieldSpec -! procedure :: make_ServiceSpec_new -! procedure :: make_WildcardSpec procedure :: make_dependencies procedure, private :: pick_geom_ -!!$ procedure :: make_StateSpec -!!$ procedure :: make_BundleSpec -!!$ procedure :: initialize procedure :: initialize end type VariableSpec @@ -229,9 +219,6 @@ end function make_virtualPt ! call item_spec%set_dependencies(dependencies) ! call item_spec%set_raw_dependencies(this%dependencies) ! -! if (this%state_intent == ESMF_STATEINTENT_INTERNAL) then -! call item_spec%set_active() -! end if ! ! _RETURN(_SUCCESS) ! end function make_ItemSpec_new @@ -253,50 +240,6 @@ subroutine pick_geom_(this, that_geom, geom, rc) _RETURN(_SUCCESS) end subroutine pick_geom_ - !wdb fixme deleteme This is obsolete. Should be moved to constructor/initialize for BracketSpec. -! function make_BracketSpec(this, geom, vertical_grid, rc) result(bracket_spec) -! type(BracketSpec) :: bracket_spec -! class(VariableSpec), intent(in) :: this -! type(ESMF_Geom), optional, intent(in) :: geom -! class(VerticalGrid), intent(in) :: vertical_grid -! integer, optional, intent(out) :: rc -! -! integer :: status -! character(:), allocatable :: units -! type(FieldSpec) :: field_spec -! -! if (.not. valid(this)) then -! _RETURN(_FAILURE) -! end if -! -! call fill_units(this, units, _RC) -! -! field_spec = FieldSpec(geom=geom, vertical_grid=vertical_grid, vertical_dim_spec=this%vertical_dim_spec, ungridded_dims=this%ungridded_dims, & -! typekind=this%typekind, & -! standard_name=this%standard_name, long_name=' ', units=units, attributes=this%attributes, default_value=this%default_value) -! -! -! bracket_spec = BracketSpec(field_spec, this%bracket_size) -! -! _RETURN(_SUCCESS) -! -! contains -! -! logical function valid(this) result(is_valid) -! class(VariableSpec), intent(in) :: this -! -! is_valid = .false. ! unless -! -! if (.not. this%itemtype == MAPL_STATEITEM_BRACKET) return -! if (.not. allocated(this%standard_name)) return -! if (.not. allocated(this%bracket_size)) return -! -! is_valid = .true. -! -! end function valid -! -! end function make_BracketSpec - subroutine fill_units(this, units, rc) class(VariableSpec), intent(in) :: this character(:), allocatable, intent(out) :: units @@ -321,126 +264,6 @@ subroutine fill_units(this, units, rc) _RETURN(_SUCCESS) end subroutine fill_units - !wdb fixme deleteme This is obsolete. -! function make_FieldSpec(this, geom, vertical_grid, rc) result(field_spec) -! type(FieldSpec) :: field_spec -! class(VariableSpec), intent(in) :: this -! type(ESMF_Geom), optional, intent(in) :: geom -! class(VerticalGrid), optional, intent(in) :: vertical_grid -! integer, optional, intent(out) :: rc -! -! integer :: status -! character(:), allocatable :: units -! -! if (.not. valid(this)) then -! _RETURN(_FAILURE) -! end if -! -! _ASSERT(this%vertical_dim_spec /= VERTICAL_DIM_UNKNOWN, 'must provide a vertical dim spec') -! call fill_units(this, units, _RC) -! -! field_spec = FieldSpec(geom=geom, vertical_grid=vertical_grid, vertical_dim_spec=this%vertical_dim_spec, ungridded_dims=this%ungridded_dims, & -! typekind=this%typekind, & -! standard_name=this%standard_name, long_name=' ', units=units, attributes=this%attributes, default_value=this%default_value) -! -! _RETURN(_SUCCESS) -! -! contains -! -! logical function valid(this) result(is_valid) -! class(VariableSpec), intent(in) :: this -! -! is_valid = .false. ! unless -! -! if (.not. this%itemtype == MAPL_STATEITEM_FIELD) return -!# if (.not. allocated(this%standard_name)) return -! -! is_valid = .true. -! -! end function valid -! -! end function make_FieldSpec - - !wdb fixme deleteme This needs to be moved to constructor/initialize for ServiceSpec. - ! ------ - ! ServiceSpec needs reference to the specs of the fields that are to be - ! handled by the service. Shallow copy of these will appear in the FieldBundle in the - ! import state of the requesting gridcomp. - ! ------ -! function make_ServiceSpec_new(this, registry, rc) result(service_spec) -! type(ServiceSpec) :: service_spec -! class(VariableSpec), intent(in) :: this -! type(StateRegistry), target, intent(in) :: registry -! integer, optional, intent(out) :: rc -! -! integer :: status -! integer :: i, n -! type(StateItemSpecPtr), allocatable :: specs(:) -! type(VirtualConnectionPt) :: v_pt -! type(StateItemExtension), pointer :: primary -! -! if (.not. valid(this)) then -! _RETURN(_FAILURE) -! end if -! -! n = this%service_items%size() -! allocate(specs(n)) -! -! do i = 1, n -! v_pt = VirtualConnectionPt(ESMF_STATEINTENT_INTERNAL, this%service_items%of(i)) -! ! Internal items are always unique and "primary" (owned by user) -! primary => registry%get_primary_extension(v_pt, _RC) -! specs(i)%ptr => primary%get_spec() -! end do -! service_spec = ServiceSpec(specs) -! -! _RETURN(_SUCCESS) -! -! contains -! -! logical function valid(this) result(is_valid) -! class(VariableSpec), intent(in) :: this -! -! is_valid = .false. ! unless -! if (.not. this%itemtype == MAPL_STATEITEM_SERVICE) return -! is_valid = .true. -! -! end function valid -! -! end function make_ServiceSpec_new - - !wdb fixme deleteme This is obsolete. Needs to move to constructor/initialize for WildcardSpec. -! function make_WildcardSpec(this, geom, vertical_grid, rc) result(wildcard_spec) -! type(WildcardSpec) :: wildcard_spec -! class(VariableSpec), intent(in) :: this -! type(ESMF_Geom), optional, intent(in) :: geom -! class(VerticalGrid), intent(in) :: vertical_grid -! integer, optional, intent(out) :: rc -! -! integer :: status -! type(FieldSpec) :: field_spec -! -! field_spec = new_FieldSpec_geom(geom=geom, vertical_grid=vertical_grid, & -! vertical_dim_spec=this%vertical_dim_spec, typekind=this%typekind, ungridded_dims=this%ungridded_dims, & -! attributes=this%attributes, default_value=this%default_value) -! wildcard_spec = WildCardSpec(field_spec) -! -! _RETURN(_SUCCESS) -! contains -! -! logical function valid(this) result(is_valid) -! class(VariableSpec), intent(in) :: this -! -! is_valid = .false. ! unless -! if (allocated(this%standard_name)) return -! if (allocated(this%units)) return ! maybe this can be relaxed - match only thisgs that have same units? -! if (this%attributes%size() > 0) return -! if (allocated(this%default_value)) return -! is_valid = .true. -! -! end function valid -! end function make_WildcardSpec - function make_dependencies(this, rc) result(dependencies) type(ActualPtVector) :: dependencies class(VariableSpec), intent(in) :: this diff --git a/generic3g/specs/make_itemSpec.F90 b/generic3g/specs/make_itemSpec.F90 index 3f049e14d6f2..ea9fa50e501d 100644 --- a/generic3g/specs/make_itemSpec.F90 +++ b/generic3g/specs/make_itemSpec.F90 @@ -11,6 +11,7 @@ module mapl3g_make_itemSpec use mapl3g_InvalidSpec, only: InvalidSpec use mapl3g_StateRegistry, only: StateRegistry use mapl_ErrorHandling + use esmf, only: ESMF_STATEINTENT_INTERNAL, operator(==) implicit none private public :: make_ItemSpec @@ -19,6 +20,7 @@ module mapl3g_make_itemSpec function make_itemSpec(variable_spec, registry, rc) result(item_spec) use mapl3g_VariableSpec, only: VariableSpec + use mapl3g_ActualPtVector, only: ActualPtVector class(StateItemSpec), allocatable :: item_spec class(VariableSpec), intent(in) :: variable_spec type(StateRegistry), pointer, intent(in) :: registry @@ -26,6 +28,7 @@ function make_itemSpec(variable_spec, registry, rc) result(item_spec) integer :: status type(FieldSpec) :: field_spec + type(ActualPtVector) :: dependencies select case (variable_spec%itemtype%ot) case (MAPL_STATEITEM_FIELD%ot) @@ -49,6 +52,14 @@ function make_itemSpec(variable_spec, registry, rc) result(item_spec) _FAIL('Unsupported type.') end select + if (variable_spec%state_intent == ESMF_STATEINTENT_INTERNAL) then + call item_spec%set_active() + end if + + dependencies = variable_spec%make_dependencies(_RC) + call item_spec%set_dependencies(dependencies) + call item_spec%set_raw_dependencies(variable_spec%dependencies) + _RETURN(_SUCCESS) end function make_itemSpec diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index e83b8c9a48f1..c0af5fbbe173 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -125,7 +125,7 @@ contains ScenarioDescription('precision_extension', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('precision_extension_3d', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('3d_specs', 'parent.yaml', check_name, check_stateitem), & - ScenarioDescription('ungridded_dims', 'parent.yaml', check_name, check_stateitem), & + ScenarioDescription('ungridded_dims', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('service_service', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('export_dependency', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('regrid', 'cap.yaml', check_name, check_stateitem), & @@ -329,6 +329,9 @@ contains expected_itemtype = get_expected_itemtype(expectations, _RC) itemtype = get_itemtype(state, short_name, _RC) + if (expected_itemtype /= itemtype) then + _HERE, msg + end if @assert_that('check item type of '//short_name, expected_itemtype == itemtype, is(true())) rc = 0 diff --git a/generic3g/tests/gridcomps/ProtoExtDataGC.F90 b/generic3g/tests/gridcomps/ProtoExtDataGC.F90 index 752024de578c..530dd5b58eef 100644 --- a/generic3g/tests/gridcomps/ProtoExtDataGC.F90 +++ b/generic3g/tests/gridcomps/ProtoExtDataGC.F90 @@ -16,8 +16,10 @@ module ProtoExtDataGC use mapl3g_StateItemSpec use mapl3g_StateItemExtension use mapl3g_ESMF_Subset + use MAPL_FieldUtils + use esmf, only: ESMF_StateGet, ESMF_FieldGet - implicit none + implicit none (type, external) private public :: setservices @@ -32,13 +34,73 @@ subroutine setservices(gc, rc) integer :: status call MAPL_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, run, _RC) - call MAPL_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, init_modify_advertise, phase_name='GENERIC::INIT_MODIFY_ADVERTISE', _RC) + call MAPL_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, init_modify_advertised, phase_name='GENERIC::INIT_MODIFY_ADVERTISED', _RC) + call MAPL_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, init_modify_advertised2, phase_name='GENERIC::INIT_MODIFY_ADVERTISED2', _RC) _RETURN(ESMF_SUCCESS) end subroutine setservices - subroutine init_modify_advertise(gc, importState, exportState, clock, rc) + subroutine init_modify_advertised(gc, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gc + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(OuterMetaComponent), pointer :: outer_meta + integer :: status + type(VirtualConnectionPt) :: export_v_pt, import_v_pt + type(ActualConnectionPt) :: a_pt + type(ConnectionPt) :: s_pt, d_pt + type(SimpleConnection) :: conn + type(StateRegistry), pointer :: registry, collection_registry + class(StateItemSpec), pointer :: export_spec + class(StateItemSpec), pointer :: import_spec + type(ESMF_HConfig) :: hconfig, states_spec, state_spec, mapl_config + type(ESMF_HConfigIter) :: iter,e,b + character(:), allocatable :: var_name + type(StateItemExtension), pointer :: primary + type(StateItemExtensionPtr), target, allocatable :: extensions(:) + + call MAPL_GridCompGet(gc, hconfig=hconfig, registry=registry, _RC) + + ! We would do this quite differently in an actual ExtData implementation. + ! Here we are using information from the generic spec. + mapl_config = ESMF_HConfigCreateAt(hconfig, keystring='mapl', _RC) + + if (ESMF_HConfigIsDefined(mapl_config, keystring='states')) then + states_spec = ESMF_HConfigCreateAt(mapl_config, keystring='states') + if (ESMF_HConfigIsDefined(states_spec, keystring='export')) then + state_spec = ESMF_HConfigCreateAt(states_spec, keystring='export') + + b = ESMF_HConfigIterBegin(state_spec) + e = ESMF_HConfigIterEnd(state_spec) + iter = ESMF_HConfigIterBegin(state_spec) + do while (ESMF_HConfigIterLoop(iter,b,e)) + var_name = ESMF_HConfigAsStringMapKey(iter,_RC) + export_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_EXPORT, var_name) + import_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_IMPORT, var_name) + a_pt = ActualConnectionPt(export_v_pt) + primary => registry%get_primary_extension(export_v_pt, _RC) + export_spec => primary%get_spec() + + s_pt = ConnectionPt('collection_1', export_v_pt) + collection_registry => registry%get_subregistry(s_pt, _RC) + extensions = collection_registry%get_extensions(export_v_pt, _RC) + export_spec => extensions(1)%ptr%get_spec() + call export_spec%set_active() + + end do + + end if + end if + + call ESMF_HConfigDestroy(mapl_config, _RC) + _RETURN(ESMF_SUCCESS) + end subroutine init_modify_advertised + + subroutine init_modify_advertised2(gc, importState, exportState, clock, rc) type(ESMF_GridComp) :: gc type(ESMF_State) :: importState type(ESMF_State) :: exportState @@ -78,20 +140,18 @@ subroutine init_modify_advertise(gc, importState, exportState, clock, rc) export_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_EXPORT, var_name) import_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_IMPORT, var_name) a_pt = ActualConnectionPt(export_v_pt) -!# export_spec => registry%get_item_spec(a_pt, _RC) primary => registry%get_primary_extension(export_v_pt, _RC) export_spec => primary%get_spec() - - + allocate(import_spec, source=export_spec) - ! Need new payload ... (but maybe not as it will get tossed at connect() anyway.) call import_spec%create(_RC) call registry%add_primary_spec(import_v_pt, import_spec) - ! And now connect + ! And now connect export_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_EXPORT, var_name) + s_pt = ConnectionPt('collection_1', export_v_pt) d_pt = ConnectionPt('', import_v_pt) conn = SimpleConnection(source=s_pt, destination=d_pt) @@ -102,7 +162,7 @@ subroutine init_modify_advertise(gc, importState, exportState, clock, rc) call ESMF_HConfigDestroy(mapl_config, _RC) _RETURN(ESMF_SUCCESS) - end subroutine init_modify_advertise + end subroutine init_modify_advertised2 subroutine run(gc, importState, exportState, clock, rc) @@ -113,11 +173,37 @@ subroutine run(gc, importState, exportState, clock, rc) integer, intent(out) :: rc type(OuterMetaComponent), pointer :: outer_meta + type(ESMF_Field) :: f_in, f_out + character(:), allocatable :: var_name + type(ESMF_HConfigIter) :: iter,e,b + type(ESMF_HConfig) :: hconfig, states_spec, state_spec, mapl_config integer :: status - outer_meta => get_outer_meta_from_inner_gc(gc, _RC) - call outer_meta%run_children(_RC) - + + call MAPL_GridCompGet(gc, hconfig=hconfig, outer_meta=outer_meta, _RC) + call outer_meta%run_children(_RC) + + mapl_config = ESMF_HConfigCreateAt(hconfig, keystring='mapl', _RC) + if (ESMF_HConfigIsDefined(mapl_config, keystring='states')) then + states_spec = ESMF_HConfigCreateAt(mapl_config, keystring='states') + if (ESMF_HConfigIsDefined(states_spec, keystring='export')) then + state_spec = ESMF_HConfigCreateAt(states_spec, keystring='export') + b = ESMF_HConfigIterBegin(state_spec) + e = ESMF_HConfigIterEnd(state_spec) + iter = ESMF_HConfigIterBegin(state_spec) + do while (ESMF_HConfigIterLoop(iter,b,e)) + var_name = ESMF_HConfigAsStringMapKey(iter,_RC) + + call ESMF_StateGet(importState, itemName=var_name, field=f_in, _RC) + call ESMF_StateGet(exportState, itemName=var_name, field=f_out, _RC) + + call FieldCopy(f_in, f_out, _RC) + + end do + end if + end if + + _RETURN(ESMF_SUCCESS) end subroutine run diff --git a/generic3g/tests/scenarios/export_dependency/child_A.yaml b/generic3g/tests/scenarios/export_dependency/child_A.yaml index 2fb2dc75f5cc..781c374410e8 100644 --- a/generic3g/tests/scenarios/export_dependency/child_A.yaml +++ b/generic3g/tests/scenarios/export_dependency/child_A.yaml @@ -2,16 +2,14 @@ mapl: states: export: E1: - standard_name: 'E1' + standard_name: 'E1' units: 'm' dependencies: [ E2 ] default_value: 1 vertical_dim_spec: NONE E2: - standard_name: 'E2' + standard_name: 'E2' units: 'km' default_value: 1 vertical_dim_spec: NONE - - diff --git a/generic3g/tests/scenarios/export_dependency/child_B.yaml b/generic3g/tests/scenarios/export_dependency/child_B.yaml index 0f7a09073bad..1294dfe76d13 100644 --- a/generic3g/tests/scenarios/export_dependency/child_B.yaml +++ b/generic3g/tests/scenarios/export_dependency/child_B.yaml @@ -2,7 +2,6 @@ mapl: states: import: I1: - standard_name: 'I1' + standard_name: 'I1' units: 'm' vertical_dim_spec: NONE - diff --git a/generic3g/tests/scenarios/extdata_1/collection_1.yaml b/generic3g/tests/scenarios/extdata_1/collection_1.yaml index bd70e6f6fc1b..ef0d2d2dcf85 100644 --- a/generic3g/tests/scenarios/extdata_1/collection_1.yaml +++ b/generic3g/tests/scenarios/extdata_1/collection_1.yaml @@ -5,7 +5,7 @@ mapl: standard_name: 'T1' units: none typekind: R8 - default_value: 1 + default_value: 7 vertical_dim_spec: NONE E2: standard_name: 'T1' diff --git a/generic3g/tests/scenarios/extdata_1/expectations.yaml b/generic3g/tests/scenarios/extdata_1/expectations.yaml index 4ec8e28a98db..568b21269529 100644 --- a/generic3g/tests/scenarios/extdata_1/expectations.yaml +++ b/generic3g/tests/scenarios/extdata_1/expectations.yaml @@ -5,8 +5,7 @@ - component: root/ import: - E1: {status: complete, typekind: R4} - + E1: {status: complete, typekind: R4, value: 7.} - component: root import: E1: {status: complete, typekind: R4} @@ -17,7 +16,7 @@ - component: extdata/collection_1 export: - E1: {status: complete, typekind: R8} + E1: {status: complete, typekind: R8, value: 7.} E1(1): {status: complete, typekind: R4} E2: {status: complete, typekind: R4} diff --git a/generic3g/vertical/BasicVerticalGrid.F90 b/generic3g/vertical/BasicVerticalGrid.F90 index b8eb6d5410f4..91d00d655691 100644 --- a/generic3g/vertical/BasicVerticalGrid.F90 +++ b/generic3g/vertical/BasicVerticalGrid.F90 @@ -46,6 +46,7 @@ module function can_connect_to(this, src, rc) function new_BasicVerticalGrid(num_levels) result(vertical_grid) type(BasicVerticalGrid) :: vertical_grid integer, intent(in) :: num_levels + call vertical_grid%set_id() vertical_grid%num_levels = num_levels end function diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index 08bd7b24fd47..d5e6610a201f 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -36,6 +36,7 @@ function new_FixedLevelsVerticalGrid_r32(standard_name, levels) result(grid) real(REAL32), intent(in) :: levels(:) character(*), intent(in) :: standard_name + call grid%set_id() grid%standard_name = standard_name grid%levels = levels diff --git a/generic3g/vertical/ModelVerticalGrid.F90 b/generic3g/vertical/ModelVerticalGrid.F90 index 080fdffc08a5..4f97188f84b2 100644 --- a/generic3g/vertical/ModelVerticalGrid.F90 +++ b/generic3g/vertical/ModelVerticalGrid.F90 @@ -69,6 +69,7 @@ function new_ModelVerticalGrid_basic(num_levels) result(vgrid) !# character(*), intent(in) :: standard_name !# type(StateRegistry), pointer, intent(in) :: registry + call vgrid%set_id() vgrid%num_levels = num_levels !# vgrid%short_name = short_name !# vgrid%standard_name = standard_name From 2b8a24dfe24d3ad7f688d080ecf9b9bcb8a77ad8 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 29 Aug 2024 14:32:56 -0400 Subject: [PATCH 3/3] Missed that changes needed to propagate to HistoryCollection. --- generic3g/tests/Test_Scenarios.pf | 5 +---- gridcomps/History3G/HistoryCollectionGridComp.F90 | 2 +- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index c0af5fbbe173..f97b1dee5232 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -329,10 +329,7 @@ contains expected_itemtype = get_expected_itemtype(expectations, _RC) itemtype = get_itemtype(state, short_name, _RC) - if (expected_itemtype /= itemtype) then - _HERE, msg - end if - @assert_that('check item type of '//short_name, expected_itemtype == itemtype, is(true())) + @assert_that(msg // ':: check item type of '//short_name, expected_itemtype == itemtype, is(true())) rc = 0 diff --git a/gridcomps/History3G/HistoryCollectionGridComp.F90 b/gridcomps/History3G/HistoryCollectionGridComp.F90 index bfab9771efae..456851043c5c 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp.F90 @@ -44,7 +44,7 @@ subroutine setServices(gridcomp, rc) type(OuterMetaComponent), pointer :: outer_meta ! Set entry points - call MAPL_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, init_geom, phase_name='GENERIC::INIT_ADVERTISE_GEOM', _RC) + call MAPL_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, init_geom, phase_name='GENERIC::INIT_ADVERTISE', _RC) call MAPL_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_INITIALIZE, init, _RC) call MAPL_GridCompSetEntryPoint(gridcomp, ESMF_METHOD_RUN, run, phase_name='run', _RC)