Reduce the memory usage that is important for ne1024 simulation

src/biogeophys/UrbanParamsType.F90

@@ -425,7 +425,10 @@ subroutine UrbanInput(begg, endg, mode)
          if (masterproc) write(iulog,*)'PCT_URBAN is not multi-density, nlevurb set to 0'
        end if
 
-       if ( nlevurb == 0 ) return
+       if ( nlevurb == 0 ) then
+          call ncd_pio_closefile(ncid)
+          return
+       end if
 
        ! Allocate dynamic memory
        allocate(urbinp%canyon_hwr(begg:endg, numurbl), &

src/cpl/share_esmf/lnd_set_decomp_and_domain.F90

@@ -21,6 +21,8 @@ module lnd_set_decomp_and_domain
   use clm_varctl   , only : iulog, inst_suffix, FL => fname_len
   use abortutils   , only : endrun
   use perf_mod     , only : t_startf, t_stopf
+  use shr_mpishmem_mod, only : shr_mpishmem_alloc_i4_1d, shr_mpishmem_free, shr_mpishmem_fence
+  use shr_mpishmem_mod, only : shr_mpishmem_is_leader, shr_mpishmem_leader_allreduce_sum_i4
 
   implicit none
   private ! except
@@ -83,6 +85,7 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
     integer  , pointer     :: gindex_ocn(:)   ! global index space for just ocean points
     integer  , pointer     :: gindex_ctsm(:)  ! global index space for land and ocean points
     integer  , pointer     :: lndmask_glob(:)
+    integer                :: lndmask_win = -1 ! node-shared window handle for lndmask_glob (cmeps paths)
     real(r8) , pointer     :: lndfrac_glob(:)
     real(r8) , pointer     :: lndfrac_loc_input(:) => null()
     real(r8) , pointer     :: dataptr1d(:)
@@ -131,15 +134,15 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
           ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh
           ! Note that lndmask_glob and lndfrac_loc_input are allocated in lnd_set_lndmask_from_maskmesh
           call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, &
-               lndfrac_loc_input, rc)
+               lndmask_win, lndfrac_loc_input, rc)
           if (ChkErr(rc,__LINE__,u_FILE_u)) return
 #ifdef DEBUG
           ! This will get added to the ESMF PET files if DEBUG=TRUE and CREATE_ESMF_PET_FILES=TRUE
           call ESMF_VMLogMemInfo("clm: After lnd_set_lndmask_from_maskmesh ")
 #endif
        else
           ! obtain land mask from land mesh file - assume that land frac is identical to land mask
-          call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, rc)
+          call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndmask_win, rc)
           if (ChkErr(rc,__LINE__,u_FILE_u)) return
        end if
     else if (trim(driver) == 'lilac') then
@@ -185,8 +188,14 @@ subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, mes
        ldomain%mask(g) = lndmask_glob(gindex_lnd(n))
     end do
 
-    ! Deallocate global pointer memory
-    deallocate(lndmask_glob)
+    ! Deallocate global pointer memory.  The cmeps paths allocate lndmask_glob as
+    ! a per-node shared-memory window (shr_mpishmem_alloc_i4_1d), so it must be freed
+    ! with shr_mpishmem_free, not deallocate; the lilac path uses a plain allocate.
+    if (trim(driver) == 'cmeps') then
+       call shr_mpishmem_free(lndmask_glob, lndmask_win)
+    else
+       deallocate(lndmask_glob)
+    end if
 
     ! Generate a ctsm global index that includes both land and ocean points
     nocn = size(gindex_ocn)
@@ -474,7 +483,7 @@ subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d)
   end subroutine lnd_get_global_dims
 
   !===============================================================================
-  subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask_glob, lndfrac_loc, rc)
+  subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask_glob, lndmask_win, lndfrac_loc, rc)
 
     ! If the landfrac/landmask file does not exists then determine the
     ! land fraction and land mask on the land grid by mapping the mask
@@ -488,7 +497,8 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
     type(ESMF_Mesh)     , intent(in)  :: mesh_mask
     type(ESMF_VM)       , intent(in)  :: vm
     integer             , intent(in)  :: gsize
-    integer             , pointer     :: lndmask_glob(:)
+    integer             , pointer     :: lndmask_glob(:) ! node-shared global land mask
+    integer             , intent(out) :: lndmask_win     ! its shared-memory window handle
     real(r8)            , pointer     :: lndfrac_loc(:)
     integer             , intent(out) :: rc
 
@@ -500,7 +510,6 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
     type(ESMF_DistGrid)    :: distgrid_mask
     integer  , pointer     :: gindex_input(:) ! global index space for land and ocean points
     integer  , pointer     :: lndmask_loc(:)
-    integer  , pointer     :: itemp_glob(:)
     real(r8) , pointer     :: maskmask_loc(:) ! on ocean mesh
     real(r8) , pointer     :: maskfrac_loc(:) ! on land mesh
     real(r8) , pointer     :: dataptr1d(:)
@@ -527,7 +536,12 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
     klen = len_trim(flandfrac) - 3 ! remove the .nc
     flandfrac_status = flandfrac(1:klen)//'.status'
 
-    allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0
+    ! Allocate the global land mask once per shared-memory node (not once per rank).
+    ! Leader zeroes it; the compute branch below fills disjoint local points on each
+    ! rank and sums across nodes (shr_mpishmem_leader_allreduce_sum_i4).
+    call shr_mpishmem_alloc_i4_1d(mpicom, lndmask_glob, lndmask_win, gsize)
+    if (shr_mpishmem_is_leader(mpicom)) lndmask_glob(:) = 0
+    call shr_mpishmem_fence(lndmask_win)
 
     ! Determine if lndfrac/lndmask file exists
     inquire(file=trim(flandfrac), exist=lexist)
@@ -610,11 +624,7 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
        do n = 1,lsize_lnd
           lndmask_glob(gindex_input(n)) = lndmask_loc(n)
        end do
-       allocate(itemp_glob(gsize))
-       call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, &
-            reduceflag=ESMF_REDUCE_SUM, rc=rc)
-       lndmask_glob(:) = int(itemp_glob(:))
-       deallocate(itemp_glob)
+       call shr_mpishmem_leader_allreduce_sum_i4(mpicom, lndmask_glob, lndmask_win, gsize)
 
        ! deallocate memory
        deallocate(maskmask_loc)
@@ -626,21 +636,21 @@ subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask
   end subroutine lnd_set_lndmask_from_maskmesh
 
   !===============================================================================
-  subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, rc)
+  subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndmask_win, rc)
 
     ! input/out variables
     type(ESMF_Mesh)     , intent(in)  :: mesh_lnd
     type(ESMF_VM)       , intent(in)  :: vm
     integer             , intent(in)  :: gsize
-    integer             , pointer     :: lndmask_glob(:)
+    integer             , pointer     :: lndmask_glob(:) ! node-shared global land mask
+    integer             , intent(out) :: lndmask_win     ! its shared-memory window handle
     integer             , intent(out) :: rc
 
     ! local variables:
     integer             :: n
     integer             :: lsize
     integer , pointer   :: gindex(:)
     integer , pointer   :: lndmask_loc(:)
-    integer , pointer   :: itemp_glob(:)
     type(ESMF_DistGrid) :: distgrid
     type(ESMF_Array)    :: elemMaskArray
     !-------------------------------------------------------------------------------
@@ -664,19 +674,20 @@ subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, rc)
     ! Determine global landmask_glob - needed to determine the ctsm decomposition
     ! land frac, lats, lons and areas will be done below
     allocate(gindex(lsize))
-    allocate(itemp_glob(gsize))
     call ESMF_DistGridGet(distgrid, 0, seqIndexList=gindex, rc=rc)
     if (chkerr(rc,__LINE__,u_FILE_u)) return
 
-    allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0
+    ! Allocate the global land mask once per shared-memory node (not once per rank)
+    ! and build it by summing each rank's disjoint local contributions across nodes
+    ! (the leader-only reduce replaces the all-rank ESMF_VMAllReduce; bit-for-bit).
+    call shr_mpishmem_alloc_i4_1d(mpicom, lndmask_glob, lndmask_win, gsize)
+    if (shr_mpishmem_is_leader(mpicom)) lndmask_glob(:) = 0
+    call shr_mpishmem_fence(lndmask_win)
 
     do n = 1,lsize
        lndmask_glob(gindex(n)) = lndmask_loc(n)
     end do
-    call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, &
-         reduceflag=ESMF_REDUCE_SUM, rc=rc)
-    lndmask_glob(:) = int(itemp_glob(:))
-    deallocate(itemp_glob)
+    call shr_mpishmem_leader_allreduce_sum_i4(mpicom, lndmask_glob, lndmask_win, gsize)
     deallocate(gindex)
     deallocate(lndmask_loc)
 

src/main/clm_instMod.F90

@@ -459,6 +459,9 @@ subroutine clm_instInit(bounds)
     ! Even for a FATES simulation, we call this to initialize product pools
     call bgc_vegetation_inst%Init(bounds, nlfilename, GetBalanceCheckSkipSteps(), params_ncid )
 
+    ! Close parameter file - this was its last use (no subsequent reads through params_ncid)
+    call ncd_pio_closefile(params_ncid)
+
     if (use_cn .or. use_fates) then
        call crop_inst%Init(bounds)
     end if
@@ -505,8 +508,6 @@ subroutine clm_instInit(bounds)
 
     call print_accum_fields()
 
-    call ncd_pio_closefile(params_ncid)
-
     call t_stopf('init_accflds')
 
   end subroutine clm_instInit

src/main/initVerticalMod.F90

@@ -651,6 +651,9 @@ subroutine initVertical(bounds, glc_behavior, thick_wall, thick_roof)
     end do
     deallocate(std)
 
+    ! Close surface dataset - all reads complete (STD_ELEV was the last read)
+    call ncd_pio_closefile(ncid)
+
     !-----------------------------------------------
     ! SCA shape function defined
     !-----------------------------------------------
@@ -667,8 +670,6 @@ subroutine initVertical(bounds, glc_behavior, thick_wall, thick_roof)
 
     end do
 
-    call ncd_pio_closefile(ncid)
-
   end subroutine initVertical
 
   !-----------------------------------------------------------------------

src/main/organicFileMod.F90

@@ -102,6 +102,8 @@ subroutine organicrd(organic)
             dim1name=grlnd, readvar=readvar)
        if (.not. readvar) call endrun('organicrd: errror reading ORGANIC')
 
+       call ncd_pio_closefile(ncid)
+
        if ( masterproc )then
           write(iulog,*) 'Successfully read organic matter data'
           write(iulog,*)

src/main/surfrdMod.F90

@@ -408,6 +408,9 @@ subroutine surfrd_get_num_patches (lfsurdat, actual_maxsoil_patches, actual_nump
        actual_numnatpft = 0
     end if
 
+    ! Close surface dataset - no longer needed after reading dimensions
+    call ncd_pio_closefile(ncid)
+
 !jt    if(check_numpft.ne.actual_numpft)then
     if(actual_numcft+actual_numnatpft.ne.actual_maxsoil_patches)then
        write(iulog,*)'the sum of the cftdim and the natpft dim should match the lsmpft dim in the surface file'
@@ -459,6 +462,9 @@ subroutine surfrd_get_nlevurb (lfsurdat, actual_nlevurb)
     ! Read nlevurb
     call ncd_inqdlen(ncid, dimid, actual_nlevurb, 'nlevurb')
 
+    ! Close surface dataset - no longer needed after reading nlevurb
+    call ncd_pio_closefile(ncid)
+
     if ( masterproc )then
        write(iulog,*) 'Successfully read nlevurb from the surface data'
        write(iulog,*)