Skip to content

Commit 7d31e39

Browse files
mathomp4mathomp4
authored
Merge pull request #243 from GEOS-ESM/bmauer/feature/eliminate_global_mem_interp_restart
Cleanup global memory in interp_restarts.x
2 parents acc0bae + ac359d9 commit 7d31e39

File tree

3 files changed

+49
-39
lines changed

3 files changed

+49
-39
lines changed

‎CMakeLists.txt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -151,7 +151,7 @@ if (CRAY_POINTER)
151151
set_target_properties (${this} PROPERTIES COMPILE_FLAGS ${CRAY_POINTER})
152152
endif()
153153

154-
add_definitions (-DSPMD -DMAPL_MODE)
154+
add_definitions (-DSPMD -DMAPL_MODE -DFVREGRID_MAPL_MODE)
155155

156156
foreach(flag ${tmp})
157157
target_compile_options (${this} PRIVATE $<$<COMPILE_LANGUAGE:Fortran>:${flag}>)

‎fv_regrid_c2c.F90‎

Lines changed: 47 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -73,12 +73,21 @@ subroutine read_topo_file_r4(fname,output,grid,rc)
7373
integer, intent(out), optional :: rc
7474

7575
integer :: status,dims(3),funit
76+
integer :: rank
77+
type(ESMF_VM) :: vm
7678
real(real4), allocatable :: input(:,:)
79+
80+
call ESMF_VMGetCurrent(vm,_RC)
81+
call ESMF_VMGet(vm,localPet=rank,_RC)
7782
call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
78-
allocate(input(dims(1),dims(2)))
79-
open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
80-
_VERIFY(status)
81-
read(funit)input
83+
if (rank ==0) then
84+
allocate(input(dims(1),dims(2)))
85+
open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
86+
_VERIFY(status)
87+
read(funit)input
88+
else
89+
allocate(input(0,0))
90+
end if
8291
call ArrayScatter(local_array=output,global_array=input,grid=grid,_RC)
8392
_RETURN(_SUCCESS)
8493
end subroutine read_topo_file_r4
@@ -91,13 +100,22 @@ subroutine read_topo_file_r8(fname,output,grid,rc)
91100

92101
integer :: status,dims(3),funit
93102
real, allocatable :: input(:,:)
103+
integer :: rank
104+
type(ESMF_VM) :: vm
94105
real(real8), allocatable :: input_r8(:,:)
106+
107+
call ESMF_VMGetCurrent(vm,_RC)
108+
call ESMF_VMGet(vm,localPet=rank,_RC)
95109
call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
96-
allocate(input(dims(1),dims(2)),input_r8(dims(2),dims(2)))
97-
open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
98-
_VERIFY(status)
99-
read(funit)input
100-
input_r8 = input
110+
if (rank ==0) then
111+
allocate(input(dims(1),dims(2)),input_r8(dims(2),dims(2)))
112+
open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
113+
_VERIFY(status)
114+
read(funit)input
115+
input_r8 = input
116+
else
117+
allocate(input(0,0),input_r8(0,0))
118+
end if
101119
call ArrayScatter(local_array=output,global_array=input_r8,grid=grid,_RC)
102120
_RETURN(_SUCCESS)
103121
end subroutine read_topo_file_r8
@@ -200,8 +218,6 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
200218
type(FileMetadata), allocatable :: cfg(:)
201219
integer :: nDims, nVars, ivar, n_ungrid
202220
character(len=128) :: vname
203-
real(FVPRC), allocatable :: gslice_r4(:,:)
204-
real*8, allocatable :: gslice_r8(:,:)
205221
integer :: tileoff,lvar_cnt,ifile,nlev
206222
type(fv_rst), pointer :: tracer_bundles(:) => null()
207223

@@ -220,6 +236,8 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
220236
type(CubedSphereGridFactory) :: cs_factory
221237
type(ESMF_Grid) :: gridIn
222238
class(AbstractRegridder), pointer :: regridder=>null()
239+
type(ArrDescr) :: input_arrdescr
240+
integer :: n_writers,n_readers,input_i1,input_in,input_j1,input_jn
223241

224242
npx = Atm(1)%npx
225243
npy = Atm(1)%npy
@@ -231,6 +249,7 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
231249
! Read input FV core restart file
232250
fname = "fvcore_internal_restart_in"
233251

252+
call ESMF_AttributeGet(gridOut,name="num_reader",value=n_readers)
234253
if( file_exist(fname) ) then
235254

236255
allocate(cfg(1))
@@ -239,7 +258,6 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
239258
im =cfg(1)%get_dimension('lon',rc=status)
240259
jm =cfg(1)%get_dimension('lat',rc=status)
241260
km =cfg(1)%get_dimension('lev',rc=status)
242-
allocate(gslice_r8(im,jm),stat=status)
243261

244262
if(is_master()) write(*,*) 'Using GEOS restart:', fname
245263

@@ -253,6 +271,9 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
253271

254272
cs_factory = CubedSphereGridFactory(nx=Atm(1)%layout(1),ny=Atm(1)%layout(2),im_world=im,lm=km)
255273
gridIn = grid_manager%make_grid(cs_factory,rc=status)
274+
call MAPL_Grid_Interior(gridIn,input_i1,input_in,input_j1,input_jn)
275+
call ArrDescrInit(input_arrdescr,MPI_COMM_WORLD,im,im*6,km, Atm(1)%layout(1),Atm(1)%layout(2)*6,n_readers, &
276+
n_readers,input_i1,input_in,input_j1,input_jn,rc=status)
256277
regridder => new_regridder_manager%make_regridder(gridIn,gridOut,REGRID_METHOD_BILINEAR,rc=status)
257278
!--------------------------------------------------------------------!
258279
! setup input cubed-sphere domain !
@@ -297,17 +318,15 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
297318
u0(:,:,:) = 0.0
298319
tileoff = (tile-1)*(jm/ntiles)
299320
do k=1,km
300-
call MAPL_VarRead(formatter,"U",gslice_r8,lev=k)
301-
u0(is_i:ie_i,js_i:je_i,k) = gslice_r8(is_i:ie_i,tileoff+js_i:tileoff+je_i)
321+
call MAPL_VarRead(formatter,"U",u0(is_i:ie_i,js_i:je_i,k),arrdes=input_arrdescr,lev=k)
302322
enddo
303323
call print_memuse_stats('get_geos_cubed_ic: read U')
304324
! Read V
305325
allocate ( v0(isd_i:ied_i+1,jsd_i:jed_i,km) )
306326
v0(:,:,:) = 0.0
307327
tileoff = (tile-1)*(jm/ntiles)
308328
do k=1,km
309-
call MAPL_VarRead(formatter,"V",gslice_r8,lev=k)
310-
v0(is_i:ie_i,js_i:je_i,k) = gslice_r8(is_i:ie_i,tileoff+js_i:tileoff+je_i)
329+
call MAPL_VarRead(formatter,"V",v0(is_i:ie_i,js_i:je_i,k),arrdes=input_arrdescr,lev=k)
311330
enddo
312331
call print_memuse_stats('get_geos_cubed_ic: read V')
313332
allocate ( sbuffer(is_i:ie_i,km) )
@@ -347,32 +366,28 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
347366
t0(:,:,:) = 0.0
348367
tileoff = (tile-1)*(jm/ntiles)
349368
do k=1,km
350-
call MAPL_VarRead(formatter,"PT",gslice_r8,lev=k)
351-
t0(is_i:ie_i,js_i:je_i,k) = gslice_r8(is_i:ie_i,tileoff+js_i:tileoff+je_i)
369+
call MAPL_VarRead(formatter,"PT",t0(is_i:ie_i,js_i:je_i,k),arrdes=input_arrdescr,lev=k)
352370
enddo
353371
call print_memuse_stats('get_geos_cubed_ic: read T')
354372
! Read PE at Surface only
355373
allocate ( ps0(isd_i:ied_i,jsd_i:jed_i) )
356374
ps0(:,:) = 0.0
357375
tileoff = (tile-1)*(jm/ntiles)
358-
call MAPL_VarRead(formatter,"PE",gslice_r8,lev=km+1)
359-
ps0(is_i:ie_i,js_i:je_i) = gslice_r8(is_i:ie_i,tileoff+js_i:tileoff+je_i)
376+
call MAPL_VarRead(formatter,"PE",ps0(is_i:ie_i,js_i:je_i),arrdes=input_arrdescr,lev=km+1)
360377
call mpp_update_domains(ps0, domain_i)
361378
! Read PKZ
362379
allocate ( pkz0(isd_i:ied_i,jsd_i:jed_i) )
363380
pkz0(:,:) = 0.0
364381
tileoff = (tile-1)*(jm/ntiles)
365382
do k=1,km
366-
call MAPL_VarRead(formatter,"PKZ",gslice_r8,lev=k)
367-
pkz0(is_i:ie_i,js_i:je_i) = gslice_r8(is_i:ie_i,tileoff+js_i:tileoff+je_i)
383+
call MAPL_VarRead(formatter,"PKZ",pkz0(is_i:ie_i,js_i:je_i),arrdes=input_arrdescr,lev=k)
368384
t0(is_i:ie_i,js_i:je_i,k) = t0(is_i:ie_i,js_i:je_i,k)*pkz0(is_i:ie_i,js_i:je_i)
369385
enddo
370386
call print_memuse_stats('get_geos_cubed_ic: converted T')
371387
deallocate ( pkz0 )
372388

373389
call formatter%close()
374390
deallocate(cfg)
375-
deallocate(gslice_r8)
376391

377392
allocate ( gz0(isd_i:ied_i,jsd_i:jed_i) )
378393
gz0(:,:) = 0.0
@@ -425,7 +440,6 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
425440
call MAPL_NCIOGetFileType("moist_internal_restart_in",filetype)
426441

427442
lvar_cnt = 0
428-
allocate(gslice_r4(im,jm))
429443
allocate(cfg(1))
430444
call formatter%open("moist_internal_restart_in",pFIO_READ,rc=status)
431445
cfg(1) = formatter%read(rc=status)
@@ -454,16 +468,14 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
454468
end if
455469
call moist_tracers%insert(trim(vname),iq)
456470
do k=1,km
457-
call MAPL_VarRead(formatter,vname,gslice_r4,lev=k)
458-
q0(is_i:ie_i,js_i:je_i,k)=gslice_r4(is_i:ie_i,tileoff+js_i:tileoff+je_i)
471+
call MAPL_VarRead(formatter,vname,q0(is_i:ie_i,js_i:je_i,k),arrdes=input_arrdescr,lev=k)
459472
call regridder%regrid(q0(is_i:ie_i,js_i:je_i,k),qp(:,:,k,iq),rc=status)
460473
enddo
461474
call prt_maxmin( 'Q_geos_moist', q0, is_i, ie_i, js_i, je_i, ng_i, km, 1._FVPRC)
462475
enddo
463476

464477
call formatter%close()
465478
deallocate(cfg)
466-
deallocate(gslice_r4)
467479

468480
end if
469481

@@ -490,7 +502,6 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
490502
do ifile=1,size(tracer_bundles)
491503
if (is_master()) print*, 'Trying to interpolate: ',trim(tracer_bundles(ifile)%file_name)
492504

493-
allocate(gslice_r4(im,jm))
494505
allocate(cfg(1))
495506
call formatter%open(trim(tracer_bundles(ifile)%file_name),pFIO_READ,rc=status)
496507
cfg(1) = formatter%read(rc=status)
@@ -504,20 +515,17 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
504515
nlev=tracer_bundles(ifile)%vars(ivar)%nLev
505516
vname = trim(tracer_bundles(ifile)%vars(ivar)%name)
506517
if (tracer_bundles(ifile)%vars(ivar)%rank ==2) then
507-
call MAPL_VarRead(formatter,vname,gslice_r4)
508-
qlev(is_i:ie_i,js_i:je_i)=gslice_r4(is_i:ie_i,tileoff+js_i:tileoff+je_i)
518+
call MAPL_VarRead(formatter,vname,qlev(is_i:ie_i,js_i:je_i),arrdes=input_arrdescr)
509519
call regridder%regrid(qlev(is_i:ie_i,js_i:je_i),tracer_bundles(ifile)%vars(ivar)%ptr2d(is:ie,js:je),rc=status)
510520
else if (tracer_bundles(ifile)%vars(ivar)%rank ==3) then
511521
do k=1,nlev
512-
call MAPL_VarRead(formatter,vname,gslice_r4,lev=k)
513-
qlev(is_i:ie_i,js_i:je_i)=gslice_r4(is_i:ie_i,tileoff+js_i:tileoff+je_i)
522+
call MAPL_VarRead(formatter,vname,qlev(is_i:ie_i,js_i:je_i),arrdes=input_arrdescr,lev=k)
514523
call regridder%regrid(qlev(is_i:ie_i,js_i:je_i),tracer_bundles(ifile)%vars(ivar)%ptr3d(is:ie,js:je,k),rc=status)
515524
enddo
516525
else if (tracer_bundles(ifile)%vars(ivar)%rank ==4) then
517526
do n_ungrid=1,tracer_bundles(ifile)%vars(ivar)%n_ungrid
518527
do k=1,nlev
519-
call MAPL_VarRead(formatter,vname,gslice_r4,lev=k,offset2=n_ungrid)
520-
qlev(is_i:ie_i,js_i:je_i)=gslice_r4(is_i:ie_i,tileoff+js_i:tileoff+je_i)
528+
call MAPL_VarRead(formatter,vname,qlev(is_i:ie_i,js_i:je_i),arrdes=input_arrdescr,lev=k,offset2=n_ungrid)
521529
call regridder%regrid(qlev(is_i:ie_i,js_i:je_i),tracer_bundles(ifile)%vars(ivar)%ptr4d(is:ie,js:je,k,n_ungrid),rc=status)
522530
enddo
523531
enddo
@@ -527,7 +535,6 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
527535

528536
call formatter%close()
529537
deallocate(cfg)
530-
deallocate(gslice_r4)
531538
deallocate(qlev)
532539

533540
enddo
@@ -1078,6 +1085,7 @@ end subroutine remap_xyz
10781085

10791086

10801087
subroutine init_cubsph_grid(npts, is,ie, js,je, ntiles, sph_corner)
1088+
use mpp_mod, only: mpp_root_pe
10811089
!------------------------------------------------------------------!
10821090
! read/generate cubed sphere grid !
10831091
! calculate cell center from cell corners !
@@ -1097,15 +1105,16 @@ subroutine init_cubsph_grid(npts, is,ie, js,je, ntiles, sph_corner)
10971105
!------------------------------------------------------------------!
10981106
! local variables !
10991107
!------------------------------------------------------------------!
1100-
integer :: i, j, n
1108+
integer :: i, j, n, masterproc
11011109
real*8, pointer :: xs(:,:), ys(:,:)
11021110
real*8, pointer :: grid_in(:,:,:,:)
11031111
integer :: grid_type = 0
11041112
!------------------------------------------------------------------!
11051113
! create sph_corner !
11061114
!------------------------------------------------------------------!
1107-
#ifdef SMEM_MAPL_MODE
1115+
#ifdef FVREGRID_MAPL_MODE
11081116
! allocate global arrays (preferable in shared memory)
1117+
masterproc = mpp_root_pe()
11091118
if(MAPL_ShmInitialized) then
11101119
if (is_master()) write(*,*) 'Using MAPL_Shmem in external_ic: init_cubsph_grid'
11111120
call MAPL_AllocNodeArray(grid_in,Shp=(/npts,npts,2,ntiles/),rc=STATUS)
@@ -1165,7 +1174,7 @@ subroutine init_cubsph_grid(npts, is,ie, js,je, ntiles, sph_corner)
11651174
if (ABS(sph_corner(2,i,j)) < 1.e-10) sph_corner(2,i,j) = 0.0
11661175
enddo
11671176
enddo
1168-
#ifdef SMEM_MAPL_MODE
1177+
#ifdef FVREGRID_MAPL_MODE
11691178
call MAPL_SyncSharedMemory(rc=STATUS)
11701179
DEALLOCGLOB_(grid_in)
11711180
call MAPL_SyncSharedMemory(rc=STATUS)

‎interp_restarts.F90‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -394,6 +394,7 @@ program interp_restarts
394394
csfactory = CubedSphereGridFactory(im_world=npx-1,lm=npz,nx=npes_x,ny=npes_y)
395395
end if
396396
grid = grid_manager%make_grid(csfactory,rc=status)
397+
call ESMF_AttributeSet(grid,name="num_reader",value=n_readers)
397398

398399
FV_Atm(1)%flagstruct%Make_NH = .false. ! Do this after rescaling
399400
if (jm == 6*im) then

0 commit comments

Comments
 (0)