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