Merge pull request #3173 from GEOS-ESM/feature/pchakrab/fakedyn-gridcomp

Add a fake DYN grid comp

generic3g/CMakeLists.txt

@@ -79,7 +79,7 @@ esma_add_fortran_submodules(
           initialize_realize.F90 recurse.F90 apply_to_children_custom.F90
           initialize_user.F90 run_custom.F90 run_user.F90 run_clock_advance.F90
           read_restart.F90 write_restart.F90 get_name.F90 get_gridcomp.F90
-          set_geom.F90 set_vertical_grid.F90 get_registry.F90
+          set_geom.F90 set_vertical_grid.F90 get_vertical_grid.F90 get_registry.F90
           get_component_spec.F90 get_internal_state.F90 get_lgr.F90
           get_user_gc_driver.F90 connect_all.F90 set_entry_point.F90
           finalize.F90)

generic3g/MAPL_Generic.F90

@@ -218,6 +218,7 @@ subroutine gridcomp_get(gridcomp, unusable, &
         logger, &
         registry, &
         geom, &
+        vertical_grid, &
         rc)
 
       type(ESMF_GridComp), intent(inout) :: gridcomp
@@ -227,10 +228,11 @@ subroutine gridcomp_get(gridcomp, unusable, &
       class(Logger_t), optional, pointer, intent(out) :: logger
       type(StateRegistry), optional, pointer, intent(out) :: registry
       type(ESMF_Geom), optional, intent(out) :: geom
+      class(VerticalGrid), allocatable, optional, intent(out) :: vertical_grid
       integer, optional, intent(out) :: rc
 
       integer :: status
-      type(OuterMetaComponent), pointer :: outer_meta_
+      type(OuterMetaComponent), pointer :: outer_meta_, outer_meta_from_inner_gc
 
       call MAPL_GridCompGetOuterMeta(gridcomp, outer_meta_, _RC)
 
@@ -239,6 +241,10 @@ subroutine gridcomp_get(gridcomp, unusable, &
       if (present(logger)) logger => outer_meta_%get_lgr()
       if (present(registry)) registry => outer_meta_%get_registry()
       if (present(geom)) geom = outer_meta_%get_geom()
+      if (present(vertical_grid)) then
+         outer_meta_from_inner_gc => get_outer_meta_from_inner_gc(gridcomp, _RC)
+         vertical_grid = outer_meta_from_inner_gc%get_vertical_grid()
+      end if
 
       _RETURN(_SUCCESS)
       _UNUSED_DUMMY(unusable)

generic3g/OuterMetaComponent.F90

@@ -116,6 +116,7 @@ module mapl3g_OuterMetaComponent
       procedure :: get_internal_state
 
       procedure :: set_vertical_grid
+      procedure :: get_vertical_grid
 
       procedure :: connect_all
 
@@ -365,6 +366,11 @@ module subroutine set_vertical_grid(this, vertical_grid)
          class(VerticalGrid), intent(in) :: verticaL_grid
       end subroutine set_vertical_grid
 
+      module function get_vertical_grid(this) result(vertical_grid)
+         class(VerticalGrid), allocatable :: verticaL_grid
+         class(OuterMetaComponent), intent(inout) :: this
+      end function get_vertical_grid
+
       module function get_registry(this) result(registry)
          type(StateRegistry), pointer :: registry
          class(OuterMetaComponent), target, intent(in) :: this

generic3g/OuterMetaComponent/get_vertical_grid.F90

@@ -0,0 +1,15 @@
+#include "MAPL_Generic.h"
+
+submodule (mapl3g_OuterMetaComponent) get_vertical_grid_smod
+
+   implicit none
+
+contains
+
+   module function get_vertical_grid(this) result(vertical_grid)
+      class(VerticalGrid), allocatable :: verticaL_grid
+      class(OuterMetaComponent), intent(inout) :: this
+      vertical_grid = this%vertical_grid
+   end function get_vertical_grid
+
+end submodule get_vertical_grid_smod

generic3g/actions/VerticalRegridAction.F90

@@ -8,7 +8,7 @@ module mapl3g_VerticalRegridAction
    use mapl3g_CouplerPhases, only: GENERIC_COUPLER_UPDATE
    use mapl3g_VerticalRegridMethod
    use mapl3g_VerticalLinearMap, only: compute_linear_map
-   use mapl3g_CSR_SparseMatrix, only: SparseMatrix_sp => CSR_SparseMatrix_sp, matmul, shape
+   use mapl3g_CSR_SparseMatrix, only: SparseMatrix_sp => CSR_SparseMatrix_sp, matmul
    use mapl3g_FieldCondensedArray, only: assign_fptr_condensed_array
    use esmf
 
@@ -58,64 +58,31 @@ function new_VerticalRegridAction(v_in_coord, v_in_coupler, v_out_coord, v_out_c
    end function new_VerticalRegridAction
 
    subroutine initialize(this, importState, exportState, clock, rc)
-      use esmf
       class(VerticalRegridAction), intent(inout) :: this
       type(ESMF_State) :: importState
       type(ESMF_State) :: exportState
       type(ESMF_Clock) :: clock
       integer, optional, intent(out) :: rc
 
-      real(ESMF_KIND_R4), pointer :: v_in(:, :, :), v_out(:, :, :)
-      integer :: shape_in(3), shape_out(3), n_horz, n_ungridded
-      integer :: horz, ungrd, status
-
       _ASSERT(this%method == VERTICAL_REGRID_LINEAR, "regrid method can only be linear")
 
-      ! if (associated(this%v_in_coupler)) then
-      !    call this%v_in_coupler%initialize(_RC)
-      ! end if
-
-      ! if (associated(this%v_out_coupler)) then
-      !    call this%v_out_coupler%initialize(_RC)
-      ! end if
-
-      call assign_fptr_condensed_array(this%v_in_coord, v_in, _RC)
-      shape_in = shape(v_in)
-      n_horz = shape_in(1)
-      n_ungridded = shape_in(3)
-
-      call assign_fptr_condensed_array(this%v_out_coord, v_out, _RC)
-      shape_out = shape(v_out)
-      _ASSERT((shape_in(1) == shape_out(1)), "horz dims are expected to be equal")
-      _ASSERT((shape_in(3) == shape_out(3)), "ungridded dims are expected to be equal")
-
-      allocate(this%matrix(n_horz))
-
-      ! TODO: Convert to a `do concurrent` loop
-      do horz = 1, n_horz
-         do ungrd = 1, n_ungridded
-            associate(src => v_in(horz, :, ungrd), dst => v_out(horz, :, ungrd))
-              call compute_linear_map(src, dst, this%matrix(horz), _RC)
-            end associate
-         end do
-      end do
-
       _RETURN(_SUCCESS)
+      _UNUSED_DUMMY(importState)
+      _UNUSED_DUMMY(exportState)
+      _UNUSED_DUMMY(clock)
    end subroutine initialize
 
    subroutine update(this, importState, exportState, clock, rc)
-      use esmf
       class(VerticalRegridAction), intent(inout) :: this
       type(ESMF_State) :: importState
       type(ESMF_State) :: exportState
       type(ESMF_Clock) :: clock
       integer, optional, intent(out) :: rc
 
-      integer :: status
       type(ESMF_Field) :: f_in, f_out
       real(ESMF_KIND_R4), pointer :: x_in(:,:,:), x_out(:,:,:)
       integer :: shape_in(3), shape_out(3), n_horz, n_ungridded
-      integer :: horz, ungrd
+      integer :: horz, ungrd, status
 
       ! if (associated(this%v_in_coupler)) then
       !    call this%v_in_coupler%run(phase_idx=GENERIC_COUPLER_UPDATE, _RC)
@@ -125,6 +92,8 @@ subroutine update(this, importState, exportState, clock, rc)
       !    call this%v_out_coupler%run(phase_idx=GENERIC_COUPLER_UPDATE, _RC)
       ! end if
 
+      call compute_interpolation_matrix_(this%v_in_coord, this%v_out_coord, this%matrix, _RC)
+
       call ESMF_StateGet(importState, itemName='import[1]', field=f_in, _RC)
       call assign_fptr_condensed_array(f_in, x_in, _RC)
       shape_in = shape(x_in)
@@ -143,6 +112,7 @@ subroutine update(this, importState, exportState, clock, rc)
       end do
 
       _RETURN(_SUCCESS)
+      _UNUSED_DUMMY(clock)
    end subroutine update
 
    subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg)
@@ -177,4 +147,38 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg)
       _UNUSED_DUMMY(v_list)
    end subroutine write_formatted
 
+   subroutine compute_interpolation_matrix_(v_in_coord, v_out_coord, matrix, rc)
+      type(ESMF_Field), intent(inout) :: v_in_coord
+      type(ESMF_Field), intent(inout) :: v_out_coord
+      type(SparseMatrix_sp), allocatable, intent(out) :: matrix(:)
+      integer, optional, intent(out) :: rc
+
+      real(ESMF_KIND_R4), pointer :: v_in(:, :, :), v_out(:, :, :)
+      integer :: shape_in(3), shape_out(3), n_horz, n_ungridded
+      integer :: horz, ungrd, status
+
+      call assign_fptr_condensed_array(v_in_coord, v_in, _RC)
+      shape_in = shape(v_in)
+      n_horz = shape_in(1)
+      n_ungridded = shape_in(3)
+
+      call assign_fptr_condensed_array(v_out_coord, v_out, _RC)
+      shape_out = shape(v_out)
+      _ASSERT((shape_in(1) == shape_out(1)), "horz dims are expected to be equal")
+      _ASSERT((shape_in(3) == shape_out(3)), "ungridded dims are expected to be equal")
+
+      allocate(matrix(n_horz))
+
+      ! TODO: Convert to a `do concurrent` loop
+      do horz = 1, n_horz
+         do ungrd = 1, n_ungridded
+            associate(src => v_in(horz, :, ungrd), dst => v_out(horz, :, ungrd))
+              call compute_linear_map(src, dst, matrix(horz), _RC)
+            end associate
+         end do
+      end do
+
+      _RETURN(_SUCCESS)
+   end subroutine compute_interpolation_matrix_
+
 end module mapl3g_VerticalRegridAction