Merge pull request #3019 from GEOS-ESM/feature/bmauer/fixes-#2986

Feature/bmauer/fixes #2986

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)
 

generic3g/tests/Test_FixedLevelsVerticalGrid.pf

@@ -13,9 +13,37 @@ 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
+
+ @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

generic3g/vertical/FixedLevelsVerticalGrid.F90

@@ -12,13 +12,14 @@ module mapl3g_FixedLevelsVerticalGrid
  private
 
  public :: FixedLevelsVerticalGrid
+ public :: operator(==)
+ public :: operator(/=)
 
  type, extends(VerticalGrid) :: 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
@@ -29,16 +30,27 @@ 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) 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
 
@@ -79,5 +91,24 @@ logical function can_connect_to(this, src, rc)
  _UNUSED_DUMMY(src)
  end function can_connect_to
 
+ 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 
+
+ impure elemental 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
- 
+

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 = this == src
+ 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