Merge pull request #2832 from GEOS-ESM/feature/bmauer/mapl3g_cube

Add Cubed Sphere grid factory to MAPL3 geom factory

generic3g/UserSetServices.F90

@@ -152,14 +152,12 @@ subroutine run_DSOSetServices(this, gridcomp, rc)
       type(ESMF_GridComp) :: GridComp
       integer, intent(out) :: rc
 
-      integer :: status, userRC
+      integer :: status, user_status
       logical :: found
 
       _ASSERT(is_supported_dso_name(this%sharedObj), 'unsupported dso name:: <'//this%sharedObj//'>')
       call ESMF_GridCompSetServices(gridcomp, sharedObj=adjust_dso_name(this%sharedObj), &
-           userRoutine=this%userRoutine, userRoutinefound=found, userRC=userRC, rc=status)
-      _VERIFY(userRC)
-      _VERIFY(status)
+           userRoutine=this%userRoutine, userRoutinefound=found, _USERRC)
 
       _RETURN(ESMF_SUCCESS)
    end subroutine run_DSOSetServices

geom_mgr/CMakeLists.txt

@@ -33,6 +33,7 @@ add_subdirectory(CoordinateAxis)
 add_subdirectory(latlon)
 add_subdirectory(GeomManager)
 add_subdirectory(VectorBasis)
+add_subdirectory(CubedSphere)
 
 target_include_directories (${this} PUBLIC
   $<BUILD_INTERFACE:${MAPL_SOURCE_DIR}/include>)

geom_mgr/CubedSphere/CMakeLists.txt

@@ -0,0 +1,9 @@
+target_sources(MAPL.geom_mgr PRIVATE
+
+  CubedSphereGeomSpec.F90
+  CubedSphereGeomSpec_smod.F90
+  CubedSphereGeomFactory.F90
+  CubedSphereGeomFactory_smod.F90
+  CubedSphereDecomposition.F90
+  CubedSphereDecomposition_smod.F90
+)

geom_mgr/CubedSphere/CubedSphereDecomposition.F90

@@ -0,0 +1,107 @@
+module mapl3g_CubedSphereDecomposition
+   use mapl_KeywordEnforcer
+   use esmf
+   implicit none
+   private
+
+   public :: CubedSphereDecomposition
+   public :: make_CubedSphereDecomposition
+   public :: operator(==)
+   public :: operator(/=)
+
+   type :: CubedSphereDecomposition
+      private
+      integer, allocatable :: x_distribution(:)
+      integer, allocatable :: y_distribution(:)
+   contains
+      procedure :: get_x_distribution
+      procedure :: get_y_distribution
+   end type CubedSphereDecomposition
+
+   interface CubedSphereDecomposition
+      procedure :: new_CubedSphereDecomposition_basic
+      procedure :: new_CubedSphereDecomposition_petcount
+      procedure :: new_CubedSphereDecomposition_topo
+   end interface CubedSphereDecomposition
+
+   interface make_CubedSphereDecomposition
+      procedure :: make_CubedSphereDecomposition_current_vm
+      procedure :: make_CubedSphereDecomposition_vm
+   end interface make_CubedSphereDecomposition
+
+   interface operator(==)
+      procedure equal_to
+   end interface operator(==)
+
+   interface operator(/=)
+      procedure not_equal_to
+   end interface operator(/=)
+
+   integer, parameter :: R8 = ESMF_KIND_R8
+   interface
+
+      ! Constructors
+      pure module function new_CubedSphereDecomposition_basic(x_distribution, y_distribution) result(decomp)
+         type(CubedSphereDecomposition) :: decomp
+         integer, intent(in) :: x_distribution(:)
+         integer, intent(in) :: y_distribution(:)
+      end function new_CubedSphereDecomposition_basic
+
+      ! Keyword enforced to avoid ambiguity with '_topo' interface
+      pure module function new_CubedSphereDecomposition_petcount(dims, unusable, petCount) result(decomp)
+         use mapl_KeywordEnforcerMod
+         type(CubedSphereDecomposition) :: decomp
+         integer, intent(in) :: dims(2)
+         class(KeywordEnforcer), optional, intent(in) :: unusable
+         integer, intent(in) :: petCount
+      end function new_CubedSphereDecomposition_petcount
+
+      ! Keyword enforced to avoid ambiguity with '_petcount' interface
+      pure module function new_CubedSphereDecomposition_topo(dims, unusable, topology) result(decomp)
+         type(CubedSphereDecomposition) :: decomp
+         integer, intent(in) :: dims(2)
+         class(KeywordEnforcer), optional, intent(in) :: unusable
+         integer, intent(in) :: topology(2)
+      end function new_CubedSphereDecomposition_topo
+
+      ! accessors
+      pure module function get_x_distribution(decomp) result(x_distribution)
+         integer, allocatable :: x_distribution(:)
+         class(CubedSphereDecomposition), intent(in) :: decomp
+      end function get_x_distribution
+
+      pure module function get_y_distribution(decomp) result(y_distribution)
+         integer, allocatable :: y_distribution(:)
+         class(CubedSphereDecomposition), intent(in) :: decomp
+      end function get_y_distribution
+
+      ! Static factory methods
+      module function make_CubedSphereDecomposition_current_vm(dims, rc) result(decomp)
+         type(CubedSphereDecomposition) :: decomp
+         integer, intent(in) :: dims(2)
+         integer, optional, intent(out) :: rc
+      end function make_CubedSphereDecomposition_current_vm
+
+      module function make_CubedSphereDecomposition_vm(dims, vm, rc) result(decomp)
+         type(CubedSphereDecomposition) :: decomp
+         integer, intent(in) :: dims(2)
+         type(ESMF_VM), intent(in) :: vm
+         integer, optional, intent(out) :: rc
+      end function make_CubedSphereDecomposition_vm
+
+      elemental module function equal_to(decomp1, decomp2)
+         logical :: equal_to
+         type(CubedSphereDecomposition), intent(in) :: decomp1
+         type(CubedSphereDecomposition), intent(in) :: decomp2
+      end function equal_to
+
+      elemental module function not_equal_to(decomp1, decomp2)
+         logical :: not_equal_to
+         type(CubedSphereDecomposition), intent(in) :: decomp1
+         type(CubedSphereDecomposition), intent(in) :: decomp2
+      end function not_equal_to
+
+   end interface
+
+end module mapl3g_CubedSphereDecomposition
+

geom_mgr/CubedSphere/CubedSphereDecomposition_smod.F90

@@ -0,0 +1,132 @@
+#include "MAPL_ErrLog.h"
+
+submodule (mapl3g_CubedSphereDecomposition) CubedSphereDecomposition_smod
+   use mapl_ErrorHandlingMod
+   use MAPL_Base
+   implicit none
+
+contains
+
+   pure module function new_CubedSphereDecomposition_basic(x_distribution, y_distribution) result(decomp)
+      type(CubedSphereDecomposition) :: decomp
+      integer, intent(in) :: x_distribution(:)
+      integer, intent(in) :: y_distribution(:)
+
+      decomp%x_distribution = x_distribution
+      decomp%y_distribution = y_distribution
+
+   end function new_CubedSphereDecomposition_basic
+
+   pure module function new_CubedSphereDecomposition_petcount(dims, unusable, petCount) result(decomp)
+      use mapl_KeywordEnforcer
+      type(CubedSphereDecomposition) :: decomp
+      integer, intent(in) :: dims(2)
+      class(KeywordEnforcer), optional, intent(in) :: unusable
+      integer, intent(in) :: petCount
+
+      integer :: nx, nx_start
+
+      associate (aspect_ratio => real(dims(1))/dims(2))
+        nx_start = max(1, floor(sqrt(petCount * aspect_ratio)))
+        do nx = nx_start, 1, -1
+           if (mod(petcount, nx) == 0) then ! found a decomposition
+              exit
+           end if
+        end do
+      end associate
+
+      decomp = CubedSphereDecomposition(dims, topology=[nx, petCount/nx])
+
+   end function new_CubedSphereDecomposition_petcount
+
+   pure module function new_CubedSphereDecomposition_topo(dims, unusable, topology) result(decomp)
+      use mapl_KeywordEnforcer
+      type(CubedSphereDecomposition) :: decomp
+      integer, intent(in) :: dims(2)
+      class(KeywordEnforcer), optional, intent(in) :: unusable
+      integer, intent(in) :: topology(2)
+
+      allocate(decomp%x_distribution(topology(1)))
+      allocate(decomp%y_distribution(topology(2)))
+
+      call MAPL_DecomposeDim(dims(1), decomp%x_distribution, topology(1), min_DE_extent=2)
+      call MAPL_DecomposeDim(dims(2), decomp%y_distribution, topology(2), min_DE_extent=2)
+
+   end function new_CubedSphereDecomposition_topo
+
+
+   ! accessors
+   pure module function get_x_distribution(decomp) result(x_distribution)
+      integer, allocatable :: x_distribution(:)
+      class(CubedSphereDecomposition), intent(in) :: decomp
+      x_distribution = decomp%x_distribution
+   end function get_x_distribution
+
+   pure module function get_y_distribution(decomp) result(y_distribution)
+      integer, allocatable :: y_distribution(:)
+      class(CubedSphereDecomposition), intent(in) :: decomp
+      y_distribution = decomp%y_distribution
+   end function get_y_distribution
+
+   ! Static factory methods
+   module function make_CubedSphereDecomposition_current_vm(dims, rc) result(decomp)
+      type(CubedSphereDecomposition) :: decomp
+      integer, intent(in) :: dims(2)
+      integer, optional, intent(out) :: rc
+
+      integer :: status
+      type(ESMF_VM) :: vm
+
+      call ESMF_VMGetCurrent(vm, _RC)
+      decomp = make_CubedSphereDecomposition(dims, vm, _RC)
+
+      _RETURN(_SUCCESS)
+   end function make_CubedSphereDecomposition_current_vm
+
+   module function make_CubedSphereDecomposition_vm(dims, vm, rc) result(decomp)
+      type(CubedSphereDecomposition) :: decomp
+      integer, intent(in) :: dims(2)
+      type(ESMF_VM), intent(in) :: vm
+      integer, optional, intent(out) :: rc
+
+      integer :: status
+      integer :: petCount
+
+      call ESMF_VMGet(vm, petCount=petCount, _RC)
+      _ASSERT(mod(petCount,6)==0, "For cubed-sphere grid PET count must be multiple of 6")
+      petCount=petCount/6
+      decomp = CubedSphereDecomposition(dims, petCount=petCount)
+
+      _RETURN(_SUCCESS)
+   end function make_CubedSphereDecomposition_vm
+
+
+   elemental module function equal_to(decomp1, decomp2)
+      logical :: equal_to
+      type(CubedSphereDecomposition), intent(in) :: decomp1
+      type(CubedSphereDecomposition), intent(in) :: decomp2
+
+      equal_to = size(decomp1%x_distribution) == size(decomp2%x_distribution)
+      if (.not. equal_to) return
+
+      equal_to = size(decomp1%y_distribution) == size(decomp2%y_distribution)
+      if (.not. equal_to) return
+
+      equal_to = all(decomp1%x_distribution == decomp2%x_distribution)
+      if (.not. equal_to) return
+
+      equal_to = all(decomp1%y_distribution == decomp2%y_distribution)
+
+   end function equal_to
+
+   elemental module function not_equal_to(decomp1, decomp2)
+      logical :: not_equal_to
+      type(CubedSphereDecomposition), intent(in) :: decomp1
+      type(CubedSphereDecomposition), intent(in) :: decomp2
+
+      not_equal_to = .not. (decomp1 == decomp2)
+
+   end function not_equal_to
+
+end submodule CubedSphereDecomposition_smod
+

geom_mgr/CubedSphere/CubedSphereGeomFactory.F90

@@ -0,0 +1,115 @@
+#include "MAPL_ErrLog.h"
+
+module mapl3g_CubedSphereGeomFactory
+   use mapl3g_GeomSpec
+   use mapl3g_GeomFactory
+   use mapl3g_CubedSphereGeomSpec
+   use mapl_KeywordEnforcerMod
+   use gftl2_StringVector
+   use pfio
+   use esmf
+   implicit none
+   private
+
+   public :: CubedSphereGeomFactory
+
+   type, extends(GeomFactory) :: CubedSphereGeomFactory
+      private
+   contains
+      ! Mandatory interfaces
+      procedure :: make_geom_spec_from_hconfig
+      procedure :: make_geom_spec_from_metadata
+      procedure :: supports_spec
+      procedure :: supports_hconfig
+      procedure :: supports_metadata
+      procedure :: make_geom
+      procedure :: make_file_metadata
+      procedure :: make_gridded_dims
+
+      ! Helper methods
+   end type CubedSphereGeomFactory
+
+
+   interface
+
+      module function make_geom_spec_from_hconfig(this, hconfig, rc) result(geom_spec)
+         use mapl3g_GeomSpec, only: GeomSpec
+         use esmf, only: ESMF_HConfig
+         class(GeomSpec), allocatable :: geom_spec
+         class(CubedSphereGeomFactory), intent(in) :: this
+         type(ESMF_HConfig), intent(in) :: hconfig
+         integer, optional, intent(out) :: rc
+      end function make_geom_spec_from_hconfig
+
+
+      module function make_geom_spec_from_metadata(this, file_metadata, rc) result(geom_spec)
+         use mapl3g_GeomSpec, only: GeomSpec
+         use pfio, only: FileMetadata
+         class(GeomSpec), allocatable :: geom_spec
+         class(CubedSphereGeomFactory), intent(in) :: this
+         type(FileMetadata), intent(in) :: file_metadata
+         integer, optional, intent(out) :: rc
+      end function make_geom_spec_from_metadata
+
+
+      logical module function supports_spec(this, geom_spec) result(supports)
+         use mapl3g_GeomSpec, only: GeomSpec
+         class(CubedSphereGeomFactory), intent(in) :: this
+         class(GeomSpec), intent(in) :: geom_spec
+      end function supports_spec
+
+      logical module function supports_hconfig(this, hconfig, rc) result(supports)
+         use esmf, only: ESMF_HConfig
+         class(CubedSphereGeomFactory), intent(in) :: this
+         type(ESMF_HConfig), intent(in) :: hconfig
+         integer, optional, intent(out) :: rc
+
+      end function supports_hconfig
+
+      logical module function supports_metadata(this, file_metadata, rc) result(supports)
+         use pfio, only: FileMetadata
+         class(CubedSphereGeomFactory), intent(in) :: this
+         type(FileMetadata), intent(in) :: file_metadata
+         integer, optional, intent(out) :: rc
+      end function supports_metadata
+
+
+      module function make_geom(this, geom_spec, rc) result(geom)
+         use mapl3g_GeomSpec, only: GeomSpec
+         use esmf, only: ESMF_Geom
+         type(ESMF_Geom) :: geom
+         class(CubedSphereGeomFactory), intent(in) :: this
+         class(GeomSpec), intent(in) :: geom_spec
+         integer, optional, intent(out) :: rc
+      end function make_geom
+
+
+      module function create_basic_grid(spec, unusable, rc) result(grid)
+         use mapl_KeywordEnforcer
+         type(ESMF_Grid) :: grid
+         type(CubedSphereGeomSpec), intent(in) :: spec
+         class(KeywordEnforcer), optional, intent(in) :: unusable
+         integer, optional, intent(out) :: rc
+      end function create_basic_grid
+
+      module function make_gridded_dims(this, geom_spec, rc) result(gridded_dims)
+         type(StringVector) :: gridded_dims
+         class(CubedSphereGeomFactory), intent(in) :: this
+         class(GeomSpec), intent(in) :: geom_spec
+         integer, optional, intent(out) :: rc
+      end function make_gridded_dims
+
+
+      module function make_file_metadata(this, geom_spec, unusable, chunksizes, rc) result(file_metadata)
+         use mapl_KeywordEnforcerMod
+         type(FileMetadata) :: file_metadata
+         class(CubedSphereGeomFactory), intent(in) :: this
+         class(GeomSpec), intent(in) :: geom_spec
+         class(KeywordEnforcer), optional, intent(in) :: unusable
+         integer, optional, intent(in) :: chunksizes(:)
+         integer, optional, intent(out) :: rc
+      end function make_file_metadata
+
+   end interface
+end module mapl3g_CubedSphereGeomFactory
+