From b5172f41d120f7eb52196f4a31e7d001e835912e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 6 Sep 2024 15:43:35 -0400 Subject: [PATCH 1/5] fixes #2986 --- .../parse_geometry_spec.F90 | 18 +++++++++-- .../vertical/FixedLevelsVerticalGrid.F90 | 9 +++--- .../can_connect_to.F90 | 30 +++++++++++++++++++ 3 files changed, 50 insertions(+), 7 deletions(-) create mode 100644 generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 diff --git a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 index 59ff2ea76354..a151aee725b1 100644 --- a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 @@ -3,6 +3,7 @@ submodule (mapl3g_ComponentSpecParser) parse_geometry_spec_smod use mapl3g_VerticalGrid use mapl3g_BasicVerticalGrid + use mapl3g_FixedLevelsVerticalGrid implicit none(external,type) contains @@ -28,8 +29,9 @@ module function parse_geometry_spec(mapl_cfg, rc) result(geometry_spec) type(GeomManager), pointer :: geom_mgr class(GeomSpec), allocatable :: geom_spec integer :: num_levels - character(:), allocatable :: vertical_grid_class + character(:), allocatable :: vertical_grid_class, standard_name, units class(VerticalGrid), allocatable :: vertical_grid + real, allocatable :: levels(:) has_geometry_section = ESMF_HConfigIsDefined(mapl_cfg,keyString=COMPONENT_GEOMETRY_SECTION, _RC) _RETURN_UNLESS(has_geometry_section) @@ -92,8 +94,18 @@ module function parse_geometry_spec(mapl_cfg, rc) result(geometry_spec) if (has_vertical_grid) then vertical_grid_class = ESMF_HConfigAsString(vertical_grid_cfg, keyString='class', _RC) _ASSERT(vertical_grid_class == 'basic', 'unsupported class of vertical grid') - num_levels = ESMF_HConfigAsI4(vertical_grid_cfg, keyString='num_levels', _RC) - vertical_grid = BasicVerticalGrid(num_levels) + select case(vertical_grid_class) + case('basic') + num_levels = ESMF_HConfigAsI4(vertical_grid_cfg, keyString='num_levels', _RC) + vertical_grid = BasicVerticalGrid(num_levels) + case('fixedlevels') + standard_name = ESMF_HConfigAsString(vertical_grid_cfg, keyString='standard_name', _RC) + units = ESMF_HConfigAsString(vertical_grid_cfg, keyString='units', _RC) + levels = ESMF_HConfigAsR4Seq(vertical_grid_cfg, keyString='levels' ,_RC) + vertical_grid = FixedLevelsVerticalGrid(standard_name, levels, units) + case default + _FAIL('vertical grid class '//vertical_grid_class//' not supported') + end select end if geometry_spec = GeometrySpec(geom_spec=geom_spec, vertical_grid=vertical_grid) diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index efec53708b76..0b376fe7fb6d 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -17,8 +17,7 @@ module mapl3g_FixedLevelsVerticalGrid private real(kind=REAL32), allocatable :: levels(:) character(:), allocatable :: standard_name ! air_pressure, height, etc. -!# character(:), allocatable :: units -!# character(:), allocatable :: coordinate_name + character(:), allocatable :: units contains procedure :: get_num_levels procedure :: get_coordinate_field @@ -31,14 +30,16 @@ module mapl3g_FixedLevelsVerticalGrid contains - function new_FixedLevelsVerticalGrid_r32(standard_name, levels) result(grid) + function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(grid) type(FixedLevelsVerticalGrid) :: grid real(REAL32), intent(in) :: levels(:) character(*), intent(in) :: standard_name + character(*), intent(in) :: units call grid%set_id() grid%standard_name = standard_name grid%levels = levels + grid%units = units end function new_FixedLevelsVerticalGrid_r32 @@ -80,4 +81,4 @@ logical function can_connect_to(this, src, rc) end function can_connect_to end module mapl3g_FixedLevelsVerticalGrid - + diff --git a/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 b/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 new file mode 100644 index 000000000000..26f38b02263d --- /dev/null +++ b/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 @@ -0,0 +1,30 @@ +#include "MAPL_ErrLog.h" +submodule (mapl3g_FixedLevelsVerticalGrid) can_connect_to_smod + use mapl3g_MirrorVerticalGrid + use mapl3g_ModelVerticalGrid + use mapl3g_BasicVerticalGrid + +contains + + logical module function can_connect_to(this, src, rc) + class(FixedLevelsVerticalGrid), intent(in) :: this + class(VerticalGrid), intent(in) :: src + integer, optional, intent(out) :: rc + + select type(src) + type is (FixedLevelsVeritcalGrid) + can_connect_to = + type is (BasicVerticalGrid) + can_connect_to = (this%get_num_levels() == src%get_num_levels()) + type is (MirrorVerticalGrid) + can_connect_to = .true. + type is (ModelVerticalGrid) + can_connect_to = (this%get_num_levels() == src%get_num_levels()) + class default + _FAIL('BasicVerticalGrid can only connect to src BasicVerticalGrid, MirrorVerticalGrid, or ModelVerticalGrid instances.') + end select + + _RETURN(_SUCCESS) + end function can_connect_to + +end submodule From 5ce11ffa1e8902ab1ca08b978e4c15b6c9fb2a18 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 9 Sep 2024 13:36:16 -0400 Subject: [PATCH 2/5] fixes #2986 --- .../tests/Test_FixedLevelsVerticalGrid.pf | 15 +++++++++- .../vertical/FixedLevelsVerticalGrid.F90 | 28 +++++++++++++++++++ .../can_connect_to.F90 | 2 +- 3 files changed, 43 insertions(+), 2 deletions(-) diff --git a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf index aa6610191940..36ab5d58590f 100644 --- a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf +++ b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf @@ -13,9 +13,22 @@ contains real, parameter :: levels(*) = [1.,5.,7.] - vgrid = FixedLevelsVerticalGrid(standard_name='air_pressure', levels=levels) + vgrid = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels) @assert_that(vgrid%get_num_levels(), is(size(levels))) end subroutine test_num_levels + + @test + subroutine test_equals() + type(FixedLevelsVerticalGrid) :: vgrid1, vgrid2 + + real, parameter :: levels(*) = [1.,5.,7.] + + vgrid1 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels) + vgrid2 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels) + @assert_that(vgrid1==vgrid2, is(.true.)) + + end subroutine test_equals + end module Test_FixedLevelsVerticalGrid diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index 0b376fe7fb6d..1727b2dc19a0 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -12,6 +12,8 @@ module mapl3g_FixedLevelsVerticalGrid private public :: FixedLevelsVerticalGrid + public :: operator(==) + public :: operator(/=) type, extends(VerticalGrid) :: FixedLevelsVerticalGrid private @@ -28,6 +30,15 @@ module mapl3g_FixedLevelsVerticalGrid procedure new_FixedLevelsVerticalGrid_r32 end interface FixedLevelsVerticalGrid + interface operator(==) + module procedure equal_FixedLevelsVerticalGrid + end interface operator(==) + + interface operator(/=) + module procedure not_equal_FixedLevelsVerticalGrid + end interface operator(/=) + + contains function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(grid) @@ -80,5 +91,22 @@ logical function can_connect_to(this, src, rc) _UNUSED_DUMMY(src) end function can_connect_to + logical function equal_FixedLevelsVerticalGrid(a, b) result(equal) + type(FixedLevelsVerticalGrid), intent(in) :: a, b + + equal = a%standard_name == b%standard_name + if (.not. equal) return + equal = a%units == b%units + if (.not. equal) return + equal = all(a%levels == b%levels) + end function equal_FixedLevelsVerticalGrid + + logical function not_equal_FixedLevelsVerticalGrid(a, b) result(not_equal) + type(FixedLevelsVerticalGrid), intent(in) :: a, b + + not_equal = .not. (a==b) + + end function not_equal_FixedLevelsVerticalGrid + end module mapl3g_FixedLevelsVerticalGrid diff --git a/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 b/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 index 26f38b02263d..62b6bb6ea193 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid/can_connect_to.F90 @@ -13,7 +13,7 @@ logical module function can_connect_to(this, src, rc) select type(src) type is (FixedLevelsVeritcalGrid) - can_connect_to = + can_connect_to = this == src type is (BasicVerticalGrid) can_connect_to = (this%get_num_levels() == src%get_num_levels()) type is (MirrorVerticalGrid) From 5a33741ff1d939884b9578b1a7a3da6da29d02b8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 9 Sep 2024 17:15:23 -0400 Subject: [PATCH 3/5] add tests, fix bug --- generic3g/tests/Test_FixedLevelsVerticalGrid.pf | 15 +++++++++++++++ generic3g/vertical/FixedLevelsVerticalGrid.F90 | 6 ++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf index 36ab5d58590f..2230f79c8217 100644 --- a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf +++ b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf @@ -30,5 +30,20 @@ contains end subroutine test_equals + @test + subroutine test_not_equals() + type(FixedLevelsVerticalGrid) :: vgrid1, vgrid2, vgrid3 + + real, parameter :: levels1(*) = [1.,5.,7.] + real, parameter :: levels2(*) = [.01,4.] + + vgrid1 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels1) + vgrid2 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='mb', levels=levels1) + vgrid3 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels2) + @assert_that(vgrid1 /= vgrid2, is(.true.)) + @assert_that(vgrid1 /= vgrid3, is(.true.)) + + end subroutine test_not_equals + end module Test_FixedLevelsVerticalGrid diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index 1727b2dc19a0..f0dac26777bf 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -91,17 +91,19 @@ logical function can_connect_to(this, src, rc) _UNUSED_DUMMY(src) end function can_connect_to - logical function equal_FixedLevelsVerticalGrid(a, b) result(equal) + impure elemental logical function equal_FixedLevelsVerticalGrid(a, b) result(equal) type(FixedLevelsVerticalGrid), intent(in) :: a, b equal = a%standard_name == b%standard_name if (.not. equal) return equal = a%units == b%units if (.not. equal) return + equal = size(a%levels) == size(b%levels) + if (.not. equal) return equal = all(a%levels == b%levels) end function equal_FixedLevelsVerticalGrid - logical function not_equal_FixedLevelsVerticalGrid(a, b) result(not_equal) + impure elemental logical function not_equal_FixedLevelsVerticalGrid(a, b) result(not_equal) type(FixedLevelsVerticalGrid), intent(in) :: a, b not_equal = .not. (a==b) From f5c2027746b008fe22be5f50a5cf535f6ccc63af Mon Sep 17 00:00:00 2001 From: Ben Auer Date: Tue, 10 Sep 2024 11:09:41 -0400 Subject: [PATCH 4/5] Update generic3g/tests/Test_FixedLevelsVerticalGrid.pf Co-authored-by: Tom Clune --- generic3g/tests/Test_FixedLevelsVerticalGrid.pf | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf index 2230f79c8217..4eb0e5550a0b 100644 --- a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf +++ b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf @@ -26,7 +26,7 @@ contains vgrid1 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels) vgrid2 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels) - @assert_that(vgrid1==vgrid2, is(.true.)) + @assert_that(vgrid1==vgrid2, is(true())) end subroutine test_equals From bcdd6fb39d42cc0b37b92bab540356a5a1878e3e Mon Sep 17 00:00:00 2001 From: Ben Auer Date: Tue, 10 Sep 2024 11:09:47 -0400 Subject: [PATCH 5/5] Update generic3g/tests/Test_FixedLevelsVerticalGrid.pf Co-authored-by: Tom Clune --- generic3g/tests/Test_FixedLevelsVerticalGrid.pf | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf index 4eb0e5550a0b..cc01f88696e8 100644 --- a/generic3g/tests/Test_FixedLevelsVerticalGrid.pf +++ b/generic3g/tests/Test_FixedLevelsVerticalGrid.pf @@ -40,8 +40,8 @@ contains vgrid1 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels1) vgrid2 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='mb', levels=levels1) vgrid3 = FixedLevelsVerticalGrid(standard_name='air_pressure', units='Pa', levels=levels2) - @assert_that(vgrid1 /= vgrid2, is(.true.)) - @assert_that(vgrid1 /= vgrid3, is(.true.)) + @assert_that(vgrid1 /= vgrid2, is(true())) + @assert_that(vgrid1 /= vgrid3, is(true())) end subroutine test_not_equals