b4b: Move the changes to initialize the task decomposition from mpi_scan to main development

src/cpl/share_esmf/lnd_set_decomp_and_domain.F90

@@ -69,7 +69,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
     ! local variables
     type(ESMF_Mesh)        :: mesh_maskinput
     type(ESMF_Mesh)        :: mesh_lndinput
-    type(ESMF_DistGrid)    :: distgrid_ctsm
+    type(ESMF_DistGrid)    :: distgrid_ctsm   ! This appears to be local but is used later in lnd_import_export
     type(ESMF_Field)       :: field_lnd
     type(ESMF_Field)       :: field_ctsm
     type(ESMF_RouteHandle) :: rhandle_lnd2ctsm
@@ -84,7 +84,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
     integer  , pointer     :: gindex_ctsm(:)  ! global index space for land and ocean points
     integer  , pointer     :: lndmask_glob(:)
     real(r8) , pointer     :: lndfrac_glob(:)
-    real(r8) , pointer     :: lndfrac_loc_input(:)
+    real(r8) , pointer     :: lndfrac_loc_input(:) => null()
     real(r8) , pointer     :: dataptr1d(:)
     !-------------------------------------------------------------------------------
 
@@ -149,6 +149,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
     end if
     call t_stopf('lnd_set_decomp_and_domain_from_readmesh: ESMF mesh')
     call t_startf ('lnd_set_decomp_and_domain_from_readmesh: final')
+    call t_startf ('lnd_set_decomp_and_domain_from_readmesh: decomp_init')
 
     ! Determine lnd decomposition that will be used by ctsm from lndmask_glob
     call t_startf ('decompInit_lnd')
@@ -163,7 +164,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
     ! Get JUST gridcell processor bounds
     ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp
     ! so get_proc_bounds is called twice and the gridcell information is just filled in twice
-    call get_proc_bounds(bounds)
+    call get_proc_bounds(bounds, only_gridcell=.true.)
     begg = bounds%begg
     endg = bounds%endg
 
@@ -197,8 +198,10 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
           gindex_ctsm(n) = gindex_ocn(n-nlnd)
        end if
     end do
+    call t_stopf ('lnd_set_decomp_and_domain_from_readmesh: decomp_init')
 
     ! Generate a new mesh on the gindex decomposition
+    ! NOTE: The distgrid_ctsm will be used later in lnd_import_export, even though it appears to just be local
     distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
     mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc)
@@ -255,13 +258,52 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
 
     end if
 
-    ! Deallocate local pointer memory
-    deallocate(gindex_lnd)
-    deallocate(gindex_ocn)
-    deallocate(gindex_ctsm)
+    ! Deallocate local pointer memory including ESMF objects
+    call from_readmesh_dealloc( rc )
+    if (chkerr(rc,__LINE__,u_FILE_u)) return
 
     call t_stopf('lnd_set_decomp_and_domain_from_readmesh: final')
 
+
+    !===============================================================================
+    ! Internal subroutines for this subroutine
+    contains
+    !===============================================================================
+
+    subroutine from_readmesh_dealloc( rc )
+       use ESMF, only : ESMF_FieldRedistRelease, ESMF_DistGridDestroy, ESMF_FieldDestroy, ESMF_MeshDestroy
+       integer, intent(out) :: rc ! ESMF return code to indicate deallocate was successful
+
+       logical :: no_esmf_garbage = .true. ! If .true. release all ESMF data (which can be problematic if referenced again)
+
+       rc = ESMF_SUCCESS
+
+       if ( associated(lndfrac_loc_input) ) deallocate(lndfrac_loc_input)
+       deallocate(gindex_lnd)
+       deallocate(gindex_ocn)
+       deallocate(gindex_ctsm)
+       ! Destroy or release all of the ESMF objects
+       call ESMF_FieldRedistRelease( rhandle_lnd2ctsm, noGarbage=no_esmf_garbage, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+       !--------------------------------------------------------------------------
+       ! NOTE: We can't destroy the distgrid -- because it will be used later
+       ! As such we don't do the following...  EBK 08/01/2025
+       !call ESMF_DistGridDestroy( distgrid_ctsm, rc=rc)
+       !if (chkerr(rc,__LINE__,u_FILE_u)) return
+       !--------------------------------------------------------------------------
+       call ESMF_FieldDestroy( field_lnd, noGarbage=no_esmf_garbage, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+       call ESMF_FieldDestroy( field_ctsm, noGarbage=no_esmf_garbage, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+       call  ESMF_MeshDestroy( mesh_maskinput, noGarbage=no_esmf_garbage, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+       call  ESMF_MeshDestroy( mesh_lndinput, noGarbage=no_esmf_garbage, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+
+    end subroutine from_readmesh_dealloc
+
+    !-------------------------------------------------------------------------------
+
   end subroutine lnd_set_decomp_and_domain_from_readmesh
 
   !===============================================================================
@@ -331,7 +373,7 @@ subroutine lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_
     call t_stopf ('decompInit_lnd')
 
     ! Initialize processor bounds
-    call get_proc_bounds(bounds)
+    call get_proc_bounds(bounds, only_gridcell=.true.) ! only_gridcell since decomp not fully initialized
 
     ! Initialize domain data structure
     call domain_init(domain=ldomain, isgrid2d=.false., ni=1, nj=1, nbeg=1, nend=1)
@@ -469,6 +511,7 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
     character(len=CL)      :: flandfrac_status
     !-------------------------------------------------------------------------------
 
+    call t_startf('lnd_set_lndmask_from_maskmesh')
     rc = ESMF_SUCCESS
 
     flandfrac = './init_generated_files/ctsm_landfrac'//trim(inst_suffix)//'.nc'
@@ -569,6 +612,7 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
        deallocate(lndmask_loc)
 
     end if
+    call t_stopf('lnd_set_lndmask_from_maskmesh')
 
   end subroutine lnd_set_lndmask_from_maskmesh
 

src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf

@@ -66,24 +66,24 @@ contains
 
     ! The first landunit is neither natural veg nor crop
     call unittest_add_landunit(my_gi=gi, ltype=istwet, wtgcell=0.25_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8, add_simple_patch=.true.)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8, add_simple_patch=.true.)
 
     call unittest_add_landunit(my_gi=gi, ltype=1, wtgcell=0.5_r8)
     this%l1 = li
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
     ! This column (the second column on the landunit with ltype=1) will be the target for
     ! some tests of initialization of a new column
     this%c_new = ci
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
 
     call unittest_add_landunit(my_gi=gi, ltype=2, wtgcell=0.25_r8)
     this%l2 = li
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8)
-    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8, add_simple_patch=.true.)
+    call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8, add_simple_patch=.true.)
 
     call unittest_subgrid_setup_end()
 

src/main/abortutils.F90

@@ -108,7 +108,7 @@ subroutine write_point_context(subgrid_index, subgrid_level)
     !
     use clm_varctl   , only : iulog
     use decompMod    , only : subgrid_level_gridcell, subgrid_level_landunit, subgrid_level_column, subgrid_level_patch
-    use decompMod    , only : get_global_index
+    use decompMod    , only : get_global_index, procinfo
     use GridcellType , only : grc
     use LandunitType , only : lun
     use ColumnType   , only : col
@@ -124,6 +124,7 @@ subroutine write_point_context(subgrid_index, subgrid_level)
     integer :: igrc=unset, ilun=unset, icol=unset, ipft=unset   ! Local index for grid-cell, landunit, column, and patch
     integer :: ggrc=unset, glun=unset, gcol=unset, gpft=unset   ! Global index for grid-cell, landunit, column, and patch
     logical :: bad_point = .false. ! Flag to indicate if the point is bad (i.e., global index is -1)
+    integer :: i, j  ! 2D global gridcell indices
     !-----------------------------------------------------------------------
 
     if (subgrid_level == subgrid_level_gridcell) then
@@ -201,28 +202,19 @@ subroutine write_point_context(subgrid_index, subgrid_level)
 
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': local  gridcell index = ', igrc
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global gridcell index = ', ggrc
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell longitude    = ', grc%londeg(igrc)
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell latitude     = ', grc%latdeg(igrc)
 
     else if (subgrid_level == subgrid_level_landunit) then
 
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': local  landunit index = ', ilun
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global landunit index = ', glun
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global gridcell index = ', ggrc
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell longitude    = ', grc%londeg(igrc)
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell latitude     = ', grc%latdeg(igrc)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': landunit type         = ', lun%itype(subgrid_index)
 
     else if (subgrid_level == subgrid_level_column) then
 
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': local  column   index = ', icol
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global column   index = ', gcol
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global landunit index = ', glun
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global gridcell index = ', ggrc
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell longitude    = ', grc%londeg(igrc)
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell latitude     = ', grc%latdeg(igrc)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': column   type         = ', col%itype(icol)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': landunit type         = ', lun%itype(ilun)
 
     else if (subgrid_level == subgrid_level_patch) then
 
@@ -231,18 +223,45 @@ subroutine write_point_context(subgrid_index, subgrid_level)
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global column   index = ', gcol
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global landunit index = ', glun
        write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': global gridcell index = ', ggrc
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell longitude    = ', grc%londeg(igrc)
-       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell latitude     = ', grc%latdeg(igrc)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': pft      type         = ', patch%itype(ipft)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': column   type         = ', col%itype(icol)
-       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': landunit type         = ', lun%itype(ilun)
-
     else
        write(iulog,*) 'subgrid_level not supported: ', subgrid_level
        write(iulog,*) errMsg(sourcefile, __LINE__)
        write(iulog,*) 'Continuing the endrun without writing point context information'
        return
     end if
+    if ( subgrid_level >= subgrid_level_landunit )then
+       if ( ilun > 0 )then
+          write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': landunit type         = ', lun%itype(ilun)
+       else
+          write(iulog,'(a)') 'WARNING: Trouble getting the landunit index'
+       end if
+       if ( subgrid_level >= subgrid_level_column )then
+         if ( icol > 0 )then
+            write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': column   type         = ', col%itype(icol)
+         else
+            write(iulog,'(a)') 'WARNING: Trouble getting the column index'
+         end if
+         if ( subgrid_level >= subgrid_level_patch )then
+           if ( ipft > 0 )then
+              write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': patch    type         = ', patch%itype(ipft)
+           else
+              write(iulog,'(a)') 'WARNING: Trouble getting the patch index'
+           end if
+         end if
+       end if
+    end if
+    if ( igrc > 0 ) then
+       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell longitude    = ', grc%londeg(igrc)
+       write(iulog,'(a, i0, a, f12.7)') 'iam = ', iam, ': gridcell latitude     = ', grc%latdeg(igrc)
+    else
+       write(iulog,'(a)') 'WARNING: Trouble getting the gridcell index'
+    end if
+    call procinfo%calc_globalxy_indices( igrc, i, j )
+    if ( (i /= -1) .and. (j /= -1) ) then
+       write(iulog,'(a, i0, a, i0)') 'iam = ', iam, ': 2D gridcell indices = (', i, ', ', j, ')'
+    else
+       write(iulog,'(a)') 'WARNING: Trouble getting the 2D gridcell indices'
+    end if
 
   end subroutine write_point_context
 

src/main/clm_initializeMod.F90

@@ -222,8 +222,8 @@ subroutine initialize2(ni,nj, currtime)
     !-----------------------------------------------------------------------
 
     call t_startf('clm_init2_part1')
-    ! Get processor bounds for gridcells
-    call get_proc_bounds(bounds_proc)
+    ! Get processor bounds for gridcells, just for gridcells
+    call get_proc_bounds(bounds_proc, only_gridcell=.true.)  ! Just get proc bounds for gridcells, other variables won't be set until after decompInit_clumps
     begg = bounds_proc%begg; endg = bounds_proc%endg
 
     ! Initialize glc behavior
@@ -283,7 +283,7 @@ subroutine initialize2(ni,nj, currtime)
     call t_stopf('clm_decompInit_clumps')
 
     ! *** Get ALL processor bounds - for gridcells, landunit, columns and patches ***
-    call get_proc_bounds(bounds_proc)
+    call get_proc_bounds(bounds_proc)   ! This has to be done after decompInit_clumps is called
 
     ! Allocate memory for subgrid data structures
     ! This is needed here BEFORE the following call to initGridcells
@@ -424,7 +424,9 @@ subroutine initialize2(ni,nj, currtime)
     call SnowAge_init( )    ! SNICAR aging   parameters:
 
     ! Print history field info to standard out
-    call hist_printflds()
+    if ( .not. use_noio )then
+       call hist_printflds()
+    end if
 
     ! Initializate dynamic subgrid weights (for prescribed transient Patches, CNDV
     ! and/or dynamic landunits); note that these will be overwritten in a restart run