From 9670fd301b5f7b8ad8de8d5ac9d3290f01a87a92 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 11:46:09 -0500 Subject: [PATCH 01/14] Added variable 'units' to VerticalGrid and its accessors --- .../vertical/FixedLevelsVerticalGrid.F90 | 21 ++++++++++--------- generic3g/vertical/ModelVerticalGrid.F90 | 5 +++-- generic3g/vertical/VerticalGrid.F90 | 15 +++++++++++++ 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index b6deec593ea8..e097585c4077 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -23,7 +23,6 @@ module mapl3g_FixedLevelsVerticalGrid private real(kind=REAL32), allocatable :: levels(:) character(:), allocatable :: standard_name ! air_pressure, height, etc. - character(:), allocatable :: units contains procedure :: get_num_levels procedure :: get_coordinate_field @@ -45,16 +44,16 @@ module mapl3g_FixedLevelsVerticalGrid contains - function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(grid) - type(FixedLevelsVerticalGrid) :: grid + function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(vgrid) + type(FixedLevelsVerticalGrid) :: vgrid character(*), intent(in) :: standard_name real(REAL32), intent(in) :: levels(:) character(*), intent(in) :: units - call grid%set_id() - grid%standard_name = standard_name - grid%levels = levels - grid%units = units + call vgrid%set_id() + vgrid%standard_name = standard_name + vgrid%levels = levels + call vgrid%set_units(units) end function new_FixedLevelsVerticalGrid_r32 integer function get_num_levels(this) result(num_levels) @@ -77,6 +76,8 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek integer, allocatable :: local_cell_count(:) integer :: i, j, IM, JM, status + ! _HERE + ! print *, "units: ", units field = MAPL_FieldCreate( & geom=geom, & typekind=ESMF_TYPEKIND_R4, & @@ -121,9 +122,9 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg) write(unit, "(a, a, 3x, a, a, a, 3x, a, a, a, 3x, a, *(g0, 1x))", iostat=iostat, iomsg=iomsg) & "FixedLevelsVerticalGrid(", new_line("a"), & "standard name: ", this%standard_name, new_line("a"), & - "units: ", this%units, new_line("a"), & + "units: ", this%get_units(), new_line("a"), & "levels: ", this %levels - write(unit, "(a, a)", iostat=iostat, iomsg=iomsg) new_line("a"), ")" + write(unit, "(a)", iostat=iostat, iomsg=iomsg) ")" _UNUSED_DUMMY(iotype) _UNUSED_DUMMY(v_list) @@ -134,7 +135,7 @@ impure elemental logical function equal_FixedLevelsVerticalGrid(a, b) result(equ equal = a%standard_name == b%standard_name if (.not. equal) return - equal = a%units == b%units + equal = a%get_units() == b%get_units() if (.not. equal) return equal = size(a%levels) == size(b%levels) if (.not. equal) return diff --git a/generic3g/vertical/ModelVerticalGrid.F90 b/generic3g/vertical/ModelVerticalGrid.F90 index 729cc3a92dbd..80b5f4dcdf78 100644 --- a/generic3g/vertical/ModelVerticalGrid.F90 +++ b/generic3g/vertical/ModelVerticalGrid.F90 @@ -65,14 +65,16 @@ module function can_connect_to(this, src, rc) contains - function new_ModelVerticalGrid_basic(num_levels) result(vgrid) + function new_ModelVerticalGrid_basic(num_levels, units) result(vgrid) type(ModelVerticalGrid) :: vgrid integer, intent(in) :: num_levels + character(*) , intent(in) :: units !# character(*), intent(in) :: short_name !# character(*), intent(in) :: standard_name !# type(StateRegistry), pointer, intent(in) :: registry call vgrid%set_id() + call vgrid%set_units(units) vgrid%num_levels = num_levels !# vgrid%short_name = short_name !# vgrid%standard_name = standard_name @@ -126,7 +128,6 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek type(StateItemExtension), pointer :: new_extension class(StateItemSpec), pointer :: new_spec type(FieldSpec) :: goal_spec - integer :: i short_name = this%variants%of(1) v_pt = VirtualConnectionPt(state_intent="export", short_name=short_name) diff --git a/generic3g/vertical/VerticalGrid.F90 b/generic3g/vertical/VerticalGrid.F90 index d76689df4329..49d0506c88db 100644 --- a/generic3g/vertical/VerticalGrid.F90 +++ b/generic3g/vertical/VerticalGrid.F90 @@ -10,6 +10,7 @@ module mapl3g_VerticalGrid type, abstract :: VerticalGrid private integer :: id = -1 + character(:), allocatable :: units contains procedure(I_get_num_levels), deferred :: get_num_levels procedure(I_get_coordinate_field), deferred :: get_coordinate_field @@ -20,6 +21,8 @@ module mapl3g_VerticalGrid procedure :: set_id procedure :: get_id procedure :: same_id + procedure :: set_units + procedure :: get_units procedure :: make_info end type VerticalGrid @@ -88,6 +91,18 @@ logical function same_id(this, other) same_id = (this%id == other%id) end function same_id + subroutine set_units(this, units) + class(VerticalGrid), intent(inout) :: this + character(*), intent(in) :: units + this%units = units + end subroutine set_units + + function get_units(this) result(units) + character(:), allocatable :: units + class(VerticalGrid), intent(in) :: this + units = this%units + end function get_units + function make_info(this, rc) result(info) use esmf type(ESMF_Info) :: info From dc485882cd7709651850f6f569f3a30eeaa7cb87 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 11:47:02 -0500 Subject: [PATCH 02/14] ModelVerticalGrid needs units for construction --- generic3g/ComponentSpecParser/parse_geometry_spec.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 index 5c83c722b0a7..b6adb74c697a 100644 --- a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 @@ -108,7 +108,8 @@ module function parse_geometry_spec(mapl_cfg, registry, rc) result(geometry_spec vertical_grid = FixedLevelsVerticalGrid(standard_name, levels, units) case('model') num_levels = ESMF_HConfigAsI4(vertical_grid_cfg, keyString='num_levels', _RC) - vertical_grid = ModelVerticalGrid(num_levels=num_levels) + units = ESMF_HConfigAsString(vertical_grid_cfg, keyString='units', _RC) + vertical_grid = ModelVerticalGrid(num_levels=num_levels, units=units) short_name = ESMF_HConfigAsString(vertical_grid_cfg, keyString='short_name', _RC) select type(vertical_grid) type is(ModelVerticalGrid) From a8a4c47a6d7c2ea421eedcf120418c1c5d138922 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 11:50:16 -0500 Subject: [PATCH 03/14] Catching exceptions for adapter match and adapt methods --- generic3g/registry/ExtensionFamily.F90 | 4 +++- generic3g/registry/StateItemExtension.F90 | 6 ++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/generic3g/registry/ExtensionFamily.F90 b/generic3g/registry/ExtensionFamily.F90 index 37f422d5a66b..937943109e9e 100644 --- a/generic3g/registry/ExtensionFamily.F90 +++ b/generic3g/registry/ExtensionFamily.F90 @@ -122,6 +122,7 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension) type(StateItemExtensionPtr) :: extension_ptr type(StateItemExtension), pointer :: primary class(StateItemSpec), pointer :: spec + logical :: match closest_extension => null() subgroup = family%get_extensions() @@ -135,7 +136,8 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension) extension_ptr = subgroup%of(j) spec => extension_ptr%ptr%get_spec() associate (adapter => adapters(i)%adapter) - if (adapter%match(spec)) then + match = adapter%match(spec, _RC) + if (match) then call new_subgroup%push_back(extension_ptr) end if end associate diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90 index 313dc00e6f18..ec1e32785248 100644 --- a/generic3g/registry/StateItemExtension.F90 +++ b/generic3g/registry/StateItemExtension.F90 @@ -117,14 +117,16 @@ recursive function make_extension(this, goal, rc) result(extension) type(ESMF_GridComp) :: coupler_gridcomp type(StateItemAdapterWrapper), allocatable :: adapters(:) type(ESMF_Clock) :: fake_clock + logical :: match call this%spec%set_active() 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) + match = adapters(i)%adapter%match(new_spec, _RC) + if (match) cycle + call adapters(i)%adapter%adapt(new_spec, action, _RC) exit end do From 2312dee86bd9b8ae250a849082d682aa0b41f9d8 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 12:46:20 -0500 Subject: [PATCH 04/14] FixedLevelsVerticalGrid - REAL32 replaced with ESMF_KIND_R4 --- generic3g/vertical/FixedLevelsVerticalGrid.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index c26fb01e30e7..c04ede0670e6 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -10,8 +10,6 @@ module mapl3g_FixedLevelsVerticalGrid use mapl3g_VerticalDimSpec use esmf - use, intrinsic :: iso_fortran_env, only: REAL32 - implicit none private @@ -21,7 +19,7 @@ module mapl3g_FixedLevelsVerticalGrid type, extends(VerticalGrid) :: FixedLevelsVerticalGrid private - real(kind=REAL32), allocatable :: levels(:) + real(kind=ESMF_KIND_R4), allocatable :: levels(:) character(:), allocatable :: standard_name ! air_pressure, height, etc. contains procedure :: get_num_levels @@ -47,7 +45,7 @@ module mapl3g_FixedLevelsVerticalGrid function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(vgrid) type(FixedLevelsVerticalGrid) :: vgrid character(*), intent(in) :: standard_name - real(REAL32), intent(in) :: levels(:) + real(kind=ESMF_KIND_R4), intent(in) :: levels(:) character(*), intent(in) :: units call vgrid%set_id() @@ -72,7 +70,7 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek type(VerticalDimSpec), intent(in) :: vertical_dim_spec integer, optional, intent(out) :: rc - real(kind=REAL32), pointer :: farray3d(:, :, :) + real(kind=ESMF_KIND_R4), pointer :: farray3d(:, :, :) integer, allocatable :: local_cell_count(:) integer :: i, j, IM, JM, status From e07e7d0f4f8c4df8a468de934561bd276829107f Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 12:48:35 -0500 Subject: [PATCH 05/14] FieldSpec::adapt_vertical_grid - fixed a bug where the wrong units, of the field to be regridded, was being passed to get_coordinate_field --- generic3g/specs/FieldSpec.F90 | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index a32089a1e7d6..720a07186814 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -360,13 +360,16 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg) write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "long name:", this%long_name, new_line("a") end if if (allocated(this%units)) then - write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "unit:", this%units, new_line("a") + write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "units:", this%units, new_line("a") end if write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_dim_spec, new_line("a") if (allocated(this%vertical_grid)) then - write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_grid, new_line("a") + write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_grid end if write(unit, "(a)") ")" + + _UNUSED_DUMMY(iotype) + _UNUSED_DUMMY(v_list) end subroutine write_formatted function get_ungridded_bounds(this, rc) result(bounds) @@ -843,14 +846,22 @@ subroutine adapt_vertical_grid(this, spec, action, rc) type(GriddedComponentDriver), pointer :: v_in_coupler type(GriddedComponentDriver), pointer :: v_out_coupler type(ESMF_Field) :: v_in_coord, v_out_coord + type(ESMF_TypeKind_Flag) :: typekind_in, typekind_out integer :: status select type (spec) type is (FieldSpec) - call spec%vertical_grid%get_coordinate_field(v_in_coord, v_in_coupler, & - 'ignore', spec%geom, spec%typekind, spec%units, spec%vertical_dim_spec, _RC) - call this%vertical_grid%get_coordinate_field(v_out_coord, v_out_coupler, & + ! pchakrab: NEED TO RESTRICT SPEC's VERTICAL GRID TO MODEL + _ASSERT(spec%vertical_grid%get_units() == this%vertical_grid%get_units(), 'units must match') + _ASSERT(spec%vertical_dim_spec == this%vertical_dim_spec, 'temporary restriction') + call spec%vertical_grid%get_coordinate_field( & + v_in_coord, v_in_coupler, & ! output + 'ignore', spec%geom, spec%typekind, this%vertical_grid%get_units(), spec%vertical_dim_spec, _RC) + call this%vertical_grid%get_coordinate_field( & + v_out_coord, v_out_coupler, & ! output 'ignore', this%geom, this%typekind, this%units, this%vertical_dim_spec, _RC) + call ESMF_FieldGet(v_in_coord, typekind=typekind_in) + call ESMF_FieldGet(v_out_coord, typekind=typekind_out) action = VerticalRegridAction(v_in_coord, v_out_coupler, v_out_coord, v_out_coupler, this%regrid_method) spec%vertical_grid = this%vertical_grid end select @@ -975,7 +986,7 @@ subroutine adapt_units(this, spec, action, rc) _RETURN(_SUCCESS) end subroutine adapt_units - logical function adapter_match_units(this, spec, rc) result(match) + logical function adapter_match_units(this, spec, rc) result(match) class(UnitsAdapter), intent(in) :: this class(StateItemSpec), intent(in) :: spec integer, optional, intent(out) :: rc From 88f45e683010db51b332d112efbbaea8ccbcf88b Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 8 Nov 2024 11:29:06 -0700 Subject: [PATCH 06/14] ... From 2712c9c348a1adbe35c1bede21e9b8658bedb1d7 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 14:58:02 -0500 Subject: [PATCH 07/14] Added a Scenarios test where component A (model vertical grid) exports E_A and PL, which are in turn imported by components B and C (fixed levels vertical grid). Deactivated the cases vertical_regridding_2 and vertical_regridding_3 if compiler is gfortran. --- generic3g/tests/Test_Scenarios.pf | 10 +++++-- .../scenarios/vertical_regridding_3/A.yaml | 28 +++++++++++++++++++ .../scenarios/vertical_regridding_3/B.yaml | 21 ++++++++++++++ .../scenarios/vertical_regridding_3/C.yaml | 21 ++++++++++++++ .../vertical_regridding_3/expectations.yaml | 17 +++++++++++ .../vertical_regridding_3/parent.yaml | 27 ++++++++++++++++++ 6 files changed, 121 insertions(+), 3 deletions(-) create mode 100644 generic3g/tests/scenarios/vertical_regridding_3/A.yaml create mode 100644 generic3g/tests/scenarios/vertical_regridding_3/B.yaml create mode 100644 generic3g/tests/scenarios/vertical_regridding_3/C.yaml create mode 100644 generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml create mode 100644 generic3g/tests/scenarios/vertical_regridding_3/parent.yaml diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index 5c3471ea4655..0180127eb443 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -127,9 +127,13 @@ contains ScenarioDescription('export_dependency', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('regrid', 'cap.yaml', check_name, check_stateitem), & ScenarioDescription('propagate_geom', 'parent.yaml', check_name, check_stateitem), & - ScenarioDescription('vertical_regridding', 'parent.yaml', check_name, check_stateitem) & - ! ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem) & - ] + ScenarioDescription('vertical_regridding', 'parent.yaml', check_name, check_stateitem) & +#ifndef __GFORTRAN__ + , & + ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem), & + ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem) & +#endif + ] end function add_params end function get_parameters diff --git a/generic3g/tests/scenarios/vertical_regridding_3/A.yaml b/generic3g/tests/scenarios/vertical_regridding_3/A.yaml new file mode 100644 index 000000000000..ade8005e7b7a --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/A.yaml @@ -0,0 +1,28 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: model + short_name: PL + units: hPa + num_levels: 4 + + states: + import: {} + export: + PL: + standard_name: air_pressure_a + units: hPa + default_value: 17. + vertical_dim_spec: center + E_A: + standard_name: temperature_a + units: K + default_value: 17. + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/B.yaml b/generic3g/tests/scenarios/vertical_regridding_3/B.yaml new file mode 100644 index 000000000000..9a9432c4065b --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/B.yaml @@ -0,0 +1,21 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: fixed_levels + standard_name: air_pressure + units: hPa + levels: [17.] + + states: + import: + I_B: + standard_name: temperature_b + units: K + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/C.yaml b/generic3g/tests/scenarios/vertical_regridding_3/C.yaml new file mode 100644 index 000000000000..07874458a1e1 --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/C.yaml @@ -0,0 +1,21 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: fixed_levels + standard_name: air_pressure + units: hPa + levels: [17.] + + states: + import: + I_C: + standard_name: air_pressure_c + units: hPa + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml new file mode 100644 index 000000000000..19875df56e33 --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml @@ -0,0 +1,17 @@ +# For each component: +# - provide a path to the outer/user componen in the hierarchy +# - list the fields expected in each import/export/internal states +# - annotate whether field is "complete" + +- component: A + export: + PL: {status: complete} + E_A: {status: complete} + +- component: B + import: + I_B: {status: complete} + +- component: C + export: + I_C: {status: complete} diff --git a/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml b/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml new file mode 100644 index 000000000000..f03ed06601f5 --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml @@ -0,0 +1,27 @@ +mapl: + + children: + A: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/A.yaml + B: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/B.yaml + C: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/C.yaml + + states: {} + + connections: + - src_name: E_A + dst_name: I_B + src_comp: A + dst_comp: B + - src_name: PL + dst_name: I_C + src_comp: A + dst_comp: C From f1f68eac60ca6a9cc8713ddd9659e900c2f59847 Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 15:00:42 -0500 Subject: [PATCH 08/14] Updated Test_ModelVerticalGrid.pf to work in the current situation where a ModelVerticalGrid is instantiated with units --- generic3g/tests/Test_ModelVerticalGrid.pf | 44 +++++++++++------------ 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/generic3g/tests/Test_ModelVerticalGrid.pf b/generic3g/tests/Test_ModelVerticalGrid.pf index aaa9ef599e1b..57b2e3d5df61 100644 --- a/generic3g/tests/Test_ModelVerticalGrid.pf +++ b/generic3g/tests/Test_ModelVerticalGrid.pf @@ -65,19 +65,19 @@ contains rc = 0 ! Inside user "set_geom" phase. geom = make_geom(_RC) - vgrid = ModelVerticalGrid(num_levels=LM) + vgrid = ModelVerticalGrid(num_levels=LM, units="hPa") call vgrid%add_variant(short_name=var_name) ! inside OuterMeta - r = StateRegistry('dyn') + r = StateRegistry("dyn") call vgrid%set_registry(r) ! MAPL_SetVerticalGrid(...) - v_pt = VirtualConnectionPt(state_intent='export', short_name=var_name) + v_pt = VirtualConnectionPt(state_intent="export", short_name=var_name) var_spec = VariableSpec(& short_name=var_name, & state_intent=ESMF_STATEINTENT_EXPORT, & - standard_name='air_pressure', & - units='hPa', & + standard_name="air_pressure", & + units="hPa", & vertical_dim_spec=vertical_dim_spec, & default_value=3.) allocate(fld_spec, source=make_itemSpec(var_spec, r, rc=status)) @@ -96,16 +96,14 @@ contains function make_geom(rc) result(geom) integer, intent(out) :: rc type(ESMF_Geom) :: geom - type(ESMF_Grid) :: grid integer :: status type(ESMF_HConfig) :: hconfig type(GeomManager), pointer :: geom_mgr - class(GeomSpec), allocatable :: geom_spec type(MaplGeom), pointer :: mapl_geom rc = 0 geom_mgr => get_geom_manager() - hconfig = ESMF_HConfigCreate(content='{class: latlon, im_world: 6, jm_world: 7, pole: PC, dateline: DC}', _RC) + hconfig = ESMF_HConfigCreate(content="{class: latlon, im_world: 6, jm_world: 7, pole: PC, dateline: DC}", _RC) mapl_geom => geom_mgr%get_mapl_geom(hconfig, _RC) geom = mapl_geom%get_geom() end function make_geom @@ -113,24 +111,22 @@ contains @test subroutine test_num_levels() type(ModelVerticalGrid) :: vgrid - integer :: num_levels num_levels = 10 - vgrid = ModelVerticalGrid(num_levels=num_levels) + vgrid = ModelVerticalGrid(num_levels=num_levels, units="hPa") @assert_that(vgrid%get_num_levels(), is(num_levels)) end subroutine test_num_levels @test subroutine test_num_variants() type(ModelVerticalGrid) :: vgrid - integer :: num_variants - vgrid = ModelVerticalGrid(num_levels=3) + vgrid = ModelVerticalGrid(num_levels=3, units="hPa") @assert_that(vgrid%get_num_variants(), is(0)) - call vgrid%add_variant(short_name='PLE') + call vgrid%add_variant(short_name="PLE") @assert_that(vgrid%get_num_variants(), is(1)) - call vgrid%add_variant(short_name='ZLE') + call vgrid%add_variant(short_name="ZLE") @assert_that(vgrid%get_num_variants(), is(2)) end subroutine test_num_variants @@ -149,17 +145,18 @@ contains call setup("PLE", vgrid, _RC) - ple_pt = VirtualConnectionPt(state_intent='export', short_name='PLE') + ple_pt = VirtualConnectionPt(state_intent="export", short_name="PLE") extension => r%get_primary_extension(ple_pt, _RC) spec => extension%get_spec() multi_state = MultiState() call spec%add_to_state(multi_state, ActualConnectionPt(ple_pt), _RC) - call ESMF_StateGet(multi_state%exportState, itemName='PLE', field=ple, _RC) + call ESMF_StateGet(multi_state%exportState, itemName="PLE", field=ple, _RC) call ESMF_FieldGet(ple, rank=rank, _RC) allocate(localElementCount(rank)) call ESMF_FieldGet(ple, localElementCount=localElementCount, _RC) @assert_that(localElementCount, is(equal_to([IM,JM,LM+1]))) + _UNUSED_DUMMY(this) end subroutine test_created_fields_have_num_levels @test(type=ESMF_TestMethod, npes=[1]) @@ -180,16 +177,17 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & typekind=ESMF_TYPEKIND_R4, & - units='hPa', & + units="hPa", & vertical_dim_spec=VERTICAL_DIM_EDGE, & _RC) @assert_that(associated(coupler), is(false())) call ESMF_FieldGet(vcoord, fArrayPtr=a, _RC) @assert_that(a, every_item(is(equal_to(3.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_simple @test(type=ESMF_TestMethod, npes=[1]) @@ -213,10 +211,10 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & typekind=ESMF_TYPEKIND_R4, & - units='Pa', & + units="Pa", & vertical_dim_spec=VERTICAL_DIM_EDGE, & _RC) @assert_that(associated(coupler), is(true())) @@ -234,6 +232,7 @@ contains end do @assert_that(shape(a), is(equal_to([IM, JM, LM+1]))) @assert_that(a, every_item(is(equal_to(300.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_change_units_edge @test(type=ESMF_TestMethod, npes=[1]) @@ -257,9 +256,9 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & - typekind=ESMF_TYPEKIND_R4, units='Pa', & + typekind=ESMF_TYPEKIND_R4, units="Pa", & vertical_dim_spec=VERTICAL_DIM_CENTER, & _RC) @assert_that(associated(coupler), is(true())) @@ -277,6 +276,7 @@ contains end do @assert_that(shape(a), is(equal_to([IM, JM, LM]))) @assert_that(a, every_item(is(equal_to(300.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_change_units_center end module Test_ModelVerticalGrid From db3b06a6dec4f1d446e5162c70a3c817ef057f51 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 8 Nov 2024 14:39:14 -0700 Subject: [PATCH 09/14] Fix bugs in trajectory sampler when test against ARGOS_geolocation_sample - add missing if group_name /='' - add back the missing first time point in trajectory --- base/Plain_netCDF_Time.F90 | 10 +++++----- gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 | 4 +++- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index 8733f178b3ab..33c63a601a82 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -221,13 +221,13 @@ subroutine get_v1d_netcdf_R8(filename, name, array, Xdim, group_name, rc) integer :: ncid, varid, ncid2 call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) - if(present(group_name)) then + if(present(group_name) .AND. group_name/='') then ncid2= ncid call check_nc_status(nf90_inq_ncid(ncid2, group_name, ncid), _RC) end if call check_nc_status(nf90_inq_varid(ncid, name, varid), _RC) call check_nc_status(nf90_get_var(ncid, varid, array), _RC) - if(present(group_name)) then + if(present(group_name) .AND. group_name/='') then call check_nc_status(nf90_close(ncid2), _RC) else call check_nc_status(nf90_close(ncid), _RC) @@ -255,7 +255,7 @@ subroutine get_v1d_netcdf_R8_complete(filename, varname, array, att_name, att_va call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name)) then + if(present(group_name) .AND. group_name/='') then call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) ! mod ncid = ncid_grp @@ -295,7 +295,7 @@ subroutine get_att_real_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name)) then + if(present(group_name) .AND. group_name/='') then call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) ! overwrite ncid = ncid_grp @@ -323,7 +323,7 @@ subroutine get_att_char_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name)) then + if(present(group_name) .AND. group_name/='') then call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) ! overwrite ncid = ncid_grp diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index dc4e8f258851..15d3d11317f4 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -741,7 +741,9 @@ zero_obs = .false. if (jt1/=jt2) then zero_obs = .false. - if (jt1==0) jt1=1 + !-- YGYU: 8-Nov-2024 : + ! this fix bug, otherwise, the first time point is missing in ARGOS_geolocation + !!if (jt1==0) jt1=1 else ! at most one obs point exist, set it .true. zero_obs = .true. From f5776af95094b1cf0323e0aa3d56002a17307703 Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 8 Nov 2024 15:02:05 -0700 Subject: [PATCH 10/14] more addition --- base/Plain_netCDF_Time.F90 | 49 ++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index 33c63a601a82..b9c163816647 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -218,20 +218,21 @@ subroutine get_v1d_netcdf_R8(filename, name, array, Xdim, group_name, rc) real(REAL64), dimension(Xdim), intent(out) :: array integer, optional, intent(out) :: rc integer :: status - integer :: ncid, varid, ncid2 + integer :: ncid, varid, ncid2, ncid_sv call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) - if(present(group_name) .AND. group_name/='') then - ncid2= ncid - call check_nc_status(nf90_inq_ncid(ncid2, group_name, ncid), _RC) + ncid_sv = ncid + + if(present(group_name)) then + if(group_name/='') then + ncid2= ncid + call check_nc_status(nf90_inq_ncid(ncid2, group_name, ncid), _RC) + end if end if call check_nc_status(nf90_inq_varid(ncid, name, varid), _RC) call check_nc_status(nf90_get_var(ncid, varid, array), _RC) - if(present(group_name) .AND. group_name/='') then - call check_nc_status(nf90_close(ncid2), _RC) - else - call check_nc_status(nf90_close(ncid), _RC) - end if + + call check_nc_status(nf90_close(ncid_sv), _RC) _RETURN(_SUCCESS) end subroutine get_v1d_netcdf_R8 @@ -255,10 +256,12 @@ subroutine get_v1d_netcdf_R8_complete(filename, varname, array, att_name, att_va call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name) .AND. group_name/='') then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! mod - ncid = ncid_grp + if(present(group_name)) then + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! mod + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_var(ncid, varid, array), _RC) @@ -295,10 +298,12 @@ subroutine get_att_real_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name) .AND. group_name/='') then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! overwrite - ncid = ncid_grp + if(present(group_name)) then + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! overwrite + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_att(ncid, varid, att_name, att_value), _RC) @@ -323,10 +328,12 @@ subroutine get_att_char_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid - if(present(group_name) .AND. group_name/='') then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! overwrite - ncid = ncid_grp + if(present(group_name)) then + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! overwrite + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_att(ncid, varid, att_name, att_value), _RC) From 1e078a47c0d0440af473f2de3e37c070f7d4144b Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Fri, 8 Nov 2024 15:07:14 -0700 Subject: [PATCH 11/14] add items in CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index aee52b7bc2d4..0e9ee90c14f0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Allow update offsets of ±timestep in ExtData2G - Minor revision (and generalization) of grid-def for GSI purposes +- Trajectory sampler: fix a bug when group_name does not exist in netCDF file and a bug that omitted the first time point ### Changed From b1a5d953823c5d79142ba74b69e7f489e5f8652e Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Fri, 8 Nov 2024 18:23:39 -0500 Subject: [PATCH 12/14] Bug fix in vertical_regridding_3 test scenario --- generic3g/tests/Test_Scenarios.pf | 2 +- .../tests/scenarios/vertical_regridding_3/expectations.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index 0180127eb443..9a5b02317df8 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -131,7 +131,7 @@ contains #ifndef __GFORTRAN__ , & ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem), & - ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem) & + ScenarioDescription('vertical_regridding_3', 'parent.yaml', check_name, check_stateitem) & #endif ] end function add_params diff --git a/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml index 19875df56e33..4b59c6931b3a 100644 --- a/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml +++ b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml @@ -13,5 +13,5 @@ I_B: {status: complete} - component: C - export: + import: I_C: {status: complete} From bc5f383e57ba5554f92ee69f9fd1c4d69149786e Mon Sep 17 00:00:00 2001 From: Yonggang Yu Date: Sat, 9 Nov 2024 01:05:21 -0700 Subject: [PATCH 13/14] clean up --- gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 15d3d11317f4..4ae3193970c9 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -732,22 +732,11 @@ times_R8_full(1), times_R8_full(nend)) call lgr%debug ('%a %i20 %i20', 'jt1, jt2 [final intercepted position]', jt1, jt2) - -! if (jt1==jt2) then -! _FAIL('Epoch Time is too small, empty grid is generated, increase Epoch') -! endif - - !-- shift the zero item to index 1 - zero_obs = .false. if (jt1/=jt2) then zero_obs = .false. - !-- YGYU: 8-Nov-2024 : - ! this fix bug, otherwise, the first time point is missing in ARGOS_geolocation - !!if (jt1==0) jt1=1 else ! at most one obs point exist, set it .true. zero_obs = .true. - !! if (jt1==0) jt1=1 end if ! From 9f00778c970b320e82b94a77694151a9320ff60e Mon Sep 17 00:00:00 2001 From: Purnendu Chakraborty Date: Sat, 9 Nov 2024 09:28:09 -0500 Subject: [PATCH 14/14] FieldSpec.F90 - vertical regridding possible only if typekinds match --- generic3g/specs/FieldSpec.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index 720a07186814..e3abb6f67a89 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -588,8 +588,8 @@ logical function can_connect_to(this, src_spec, rc) can_connect_to = all ([ & can_match(this%geom,src_spec%geom), & can_match(this%vertical_grid, src_spec%vertical_grid), & - match(this%vertical_dim_spec,src_spec%vertical_dim_spec), & - match(this%ungridded_dims,src_spec%ungridded_dims), & + match(this%vertical_dim_spec, src_spec%vertical_dim_spec), & + match(this%ungridded_dims, src_spec%ungridded_dims), & includes(this%attributes, src_spec%attributes), & can_convert_units & ]) @@ -851,17 +851,19 @@ subroutine adapt_vertical_grid(this, spec, action, rc) select type (spec) type is (FieldSpec) - ! pchakrab: NEED TO RESTRICT SPEC's VERTICAL GRID TO MODEL + ! TODO: DO WE NEED TO RESTRICT SPEC's VERTICAL GRID TO MODEL? + ! NOTE: we cannot import ModelVerticalGrid (circular dependency) _ASSERT(spec%vertical_grid%get_units() == this%vertical_grid%get_units(), 'units must match') _ASSERT(spec%vertical_dim_spec == this%vertical_dim_spec, 'temporary restriction') + ! Field (to be regridded) should have the same typekind as the underlying vertical grid + ! TODO: Should we add a typekind class variable to VerticalGrid? + _ASSERT(spec%typekind == this%typekind, 'typekind must match') call spec%vertical_grid%get_coordinate_field( & v_in_coord, v_in_coupler, & ! output 'ignore', spec%geom, spec%typekind, this%vertical_grid%get_units(), spec%vertical_dim_spec, _RC) call this%vertical_grid%get_coordinate_field( & v_out_coord, v_out_coupler, & ! output 'ignore', this%geom, this%typekind, this%units, this%vertical_dim_spec, _RC) - call ESMF_FieldGet(v_in_coord, typekind=typekind_in) - call ESMF_FieldGet(v_out_coord, typekind=typekind_out) action = VerticalRegridAction(v_in_coord, v_out_coupler, v_out_coord, v_out_coupler, this%regrid_method) spec%vertical_grid = this%vertical_grid end select