Skip to content

Commit d810865

Browse files
authored
Break out module_dm external subroutines into separate files (#2069)
TYPE: enhancement KEYWORDS: intel, compilation, llvm, memory SOURCE: internal DESCRIPTION OF CHANGES: Problem: The Intel oneAPI compilers (and others like nvhpc) struggle with some of the larger (15k+ lines of code) files within WRF. This causes intense memory usage that is not often available to the average user not in a resource-rich environment. This often limits compilation to single threaded if even possible or to a dedicated environment with enough memory if available. If neither of those is available to a user, they will be unable to use these configurations entirely. Solution: This PR focuses on the `module_dm` sections of code to reduce its individual file size to manageable levels. This and its helper subroutines are instead broken out into many smaller files. TESTS CONDUCTED: Attached to this PR are plots of the respective effects of theses changes. Changes were tested with intel and gcc compilers, but only intel memory usage is shown as it exacerbates the memory usage issue.
1 parent ed585bd commit d810865

14 files changed

Lines changed: 1507 additions & 1320 deletions

dyn_em/interp_domain_em.F

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,9 @@ END SUBROUTINE interp_domain_em_part1
5555
SUBROUTINE interp_domain_em_part2
5656
END SUBROUTINE interp_domain_em_part2
5757

58+
SUBROUTINE interp_domain_em_part3
59+
END SUBROUTINE interp_domain_em_part3
60+
5861
#endif
5962

6063

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
#if ( EM_CORE == 1 && DA_CORE != 1 )
2+
3+
!------------------------------------------------------------------
4+
SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags &
5+
!
6+
#include "dummy_new_args.inc"
7+
!
8+
)
9+
USE module_state_description
10+
USE module_domain, ONLY : domain, get_ijk_from_grid
11+
USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
12+
USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, &
13+
ipe_save, jpe_save, ips_save, jps_save, &
14+
nest_pes_x, nest_pes_y
15+
16+
IMPLICIT NONE
17+
!
18+
TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
19+
TYPE(domain), POINTER :: ngrid
20+
#include "dummy_new_decl.inc"
21+
INTEGER nlev, msize
22+
INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
23+
TYPE(domain), POINTER :: xgrid
24+
TYPE (grid_config_rec_type) :: config_flags, nconfig_flags
25+
REAL xv(2000)
26+
INTEGER :: cids, cide, cjds, cjde, ckds, ckde, &
27+
cims, cime, cjms, cjme, ckms, ckme, &
28+
cips, cipe, cjps, cjpe, ckps, ckpe
29+
INTEGER :: nids, nide, njds, njde, nkds, nkde, &
30+
nims, nime, njms, njme, nkms, nkme, &
31+
nips, nipe, njps, njpe, nkps, nkpe
32+
33+
INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7
34+
35+
INTEGER local_comm, myproc, nproc, idum1, idum2
36+
INTEGER thisdomain_max_halo_width
37+
38+
!cyl: add variables for trajectory
39+
integer tjk
40+
41+
INTERFACE
42+
SUBROUTINE feedback_nest_prep ( grid, config_flags &
43+
!
44+
#include "dummy_new_args.inc"
45+
!
46+
)
47+
USE module_state_description
48+
USE module_domain, ONLY : domain
49+
USE module_configure, ONLY : grid_config_rec_type
50+
!
51+
TYPE (grid_config_rec_type) :: config_flags
52+
TYPE(domain), TARGET :: grid
53+
#include "dummy_new_decl.inc"
54+
END SUBROUTINE feedback_nest_prep
55+
END INTERFACE
56+
!
57+
58+
CALL wrf_get_dm_communicator ( local_comm )
59+
CALL wrf_get_myproc( myproc )
60+
CALL wrf_get_nproc( nproc )
61+
62+
!
63+
! intermediate grid
64+
CALL get_ijk_from_grid ( grid , &
65+
cids, cide, cjds, cjde, ckds, ckde, &
66+
cims, cime, cjms, cjme, ckms, ckme, &
67+
cips, cipe, cjps, cjpe, ckps, ckpe )
68+
! nest grid
69+
CALL get_ijk_from_grid ( ngrid , &
70+
nids, nide, njds, njde, nkds, nkde, &
71+
nims, nime, njms, njme, nkms, nkme, &
72+
nips, nipe, njps, njpe, nkps, nkpe )
73+
74+
nlev = ckde - ckds + 1
75+
76+
ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below
77+
jps_save = ngrid%j_parent_start
78+
ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1
79+
jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1
80+
81+
! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
82+
! in a separate routine because the HALOs need the data to be dereference from the
83+
! grid data structure and, in this routine, the dereferenced fields are related to
84+
! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
85+
! domain, switch grid to point to ngrid, invoke feedback_nest_prep, then restore grid
86+
! to point to intermediate domain.
87+
88+
CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
89+
CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
90+
xgrid => grid
91+
grid => ngrid
92+
93+
CALL feedback_nest_prep ( grid, nconfig_flags &
94+
!
95+
#include "actual_new_args.inc"
96+
!
97+
)
98+
99+
! put things back so grid is intermediate grid
100+
101+
grid => xgrid
102+
CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
103+
104+
! "interp" (basically copy) ngrid onto intermediate grid
105+
106+
#include "nest_feedbackup_interp.inc"
107+
108+
RETURN
109+
END SUBROUTINE feedback_domain_em_part1
110+
#endif
111+
Lines changed: 200 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,200 @@
1+
#if ( EM_CORE == 1 && DA_CORE != 1 )
2+
3+
!------------------------------------------------------------------
4+
5+
SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags &
6+
!
7+
#include "dummy_new_args.inc"
8+
!
9+
)
10+
USE module_state_description
11+
USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid
12+
USE module_configure, ONLY : grid_config_rec_type, model_config_rec
13+
USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, &
14+
ipe_save, jpe_save, ips_save, jps_save, get_dm_max_halo_width, &
15+
nest_pes_x, nest_pes_y, &
16+
intercomm_active, nest_task_offsets, &
17+
mpi_comm_to_mom, mpi_comm_to_kid, which_kid !, &
18+
!push_communicators_for_domain, pop_communicators_for_domain
19+
20+
USE module_comm_nesting_dm, ONLY : halo_interp_up_sub
21+
USE module_utility
22+
IMPLICIT NONE
23+
24+
!
25+
TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
26+
TYPE(domain), POINTER :: intermediate_grid
27+
TYPE(domain), POINTER :: ngrid
28+
TYPE(domain), POINTER :: parent_grid
29+
30+
#include "dummy_new_decl.inc"
31+
INTEGER nlev, msize
32+
INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
33+
TYPE (grid_config_rec_type) :: config_flags
34+
REAL xv(2000)
35+
INTEGER :: cids, cide, cjds, cjde, ckds, ckde, &
36+
cims, cime, cjms, cjme, ckms, ckme, &
37+
cips, cipe, cjps, cjpe, ckps, ckpe
38+
INTEGER :: nids, nide, njds, njde, nkds, nkde, &
39+
nims, nime, njms, njme, nkms, nkme, &
40+
nips, nipe, njps, njpe, nkps, nkpe
41+
INTEGER :: xids, xide, xjds, xjde, xkds, xkde, &
42+
xims, xime, xjms, xjme, xkms, xkme, &
43+
xips, xipe, xjps, xjpe, xkps, xkpe
44+
INTEGER :: ids, ide, jds, jde, kds, kde, &
45+
ims, ime, jms, jme, kms, kme, &
46+
ips, ipe, jps, jpe, kps, kpe
47+
48+
INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7
49+
50+
INTEGER icoord, jcoord, idim_cd, jdim_cd
51+
INTEGER local_comm, myproc, nproc, ioffset
52+
INTEGER iparstrt, jparstrt, sw, thisdomain_max_halo_width
53+
REAL nest_influence
54+
55+
character*256 :: timestr
56+
integer ierr
57+
58+
LOGICAL, EXTERNAL :: cd_feedback_mask
59+
60+
!cyl: add variables for trajectory
61+
integer tjk
62+
63+
! On entry to this routine,
64+
! "grid" refers to the parent domain
65+
! "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest
66+
! "ngrid" refers to the nest, which is only needed for smoothing on the parent because
67+
! the nest feedback data has already been transferred during em_nest_feedbackup_interp
68+
! in part1, above.
69+
! The way these settings c and n dimensions are set, below, looks backwards but from the point
70+
! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by
71+
! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain
72+
! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c
73+
! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road
74+
! sign that says "DIP" than fix the dip, at this point it was easier just to write this comment. JM
75+
!
76+
nest_influence = 1.
77+
78+
CALL domain_clock_get( grid, current_timestr=timestr )
79+
80+
CALL get_ijk_from_grid ( intermediate_grid , &
81+
cids, cide, cjds, cjde, ckds, ckde, &
82+
cims, cime, cjms, cjme, ckms, ckme, &
83+
cips, cipe, cjps, cjpe, ckps, ckpe )
84+
CALL get_ijk_from_grid ( grid , &
85+
nids, nide, njds, njde, nkds, nkde, &
86+
nims, nime, njms, njme, nkms, nkme, &
87+
nips, nipe, njps, njpe, nkps, nkpe )
88+
CALL get_ijk_from_grid ( ngrid , &
89+
xids, xide, xjds, xjde, xkds, xkde, &
90+
xims, xime, xjms, xjme, xkms, xkme, &
91+
xips, xipe, xjps, xjpe, xkps, xkpe )
92+
93+
ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below
94+
jps_save = ngrid%j_parent_start
95+
ipe_save = ngrid%i_parent_start + (xide-xids+1) / ngrid%parent_grid_ratio - 1
96+
jpe_save = ngrid%j_parent_start + (xjde-xjds+1) / ngrid%parent_grid_ratio - 1
97+
98+
99+
100+
101+
IF ( ngrid%active_this_task ) THEN
102+
!cyl add this for trajectory
103+
CALL push_communicators_for_domain( ngrid%id )
104+
105+
do tjk = 1,config_flags%num_traj
106+
if (ngrid%traj_long(tjk) .eq. -9999.0) then
107+
! print*,'n=-9999',tjk
108+
ngrid%traj_long(tjk)=grid%traj_long(tjk)
109+
ngrid%traj_k(tjk)=grid%traj_k(tjk)
110+
else
111+
! print*,'p!=-9999',tjk
112+
grid%traj_long(tjk)=ngrid%traj_long(tjk)
113+
grid%traj_k(tjk)=ngrid%traj_k(tjk)
114+
endif
115+
if (ngrid%traj_lat(tjk) .eq. -9999.0) then
116+
ngrid%traj_lat(tjk)=grid%traj_lat(tjk)
117+
ngrid%traj_k(tjk)=grid%traj_k(tjk)
118+
else
119+
grid%traj_lat(tjk)=ngrid%traj_lat(tjk)
120+
grid%traj_k(tjk)=ngrid%traj_k(tjk)
121+
endif
122+
enddo
123+
!endcyl
124+
125+
CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt )
126+
CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt )
127+
CALL nl_get_shw ( intermediate_grid%id, sw )
128+
icoord = iparstrt - sw
129+
jcoord = jparstrt - sw
130+
idim_cd = cide - cids + 1
131+
jdim_cd = cjde - cjds + 1
132+
133+
nlev = ckde - ckds + 1
134+
135+
CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width )
136+
137+
parent_grid => grid
138+
grid => ngrid
139+
#include "nest_feedbackup_pack.inc"
140+
grid => parent_grid
141+
CALL pop_communicators_for_domain
142+
143+
END IF
144+
145+
! CALL wrf_get_dm_communicator ( local_comm )
146+
! CALL wrf_get_myproc( myproc )
147+
! CALL wrf_get_nproc( nproc )
148+
149+
! determine which communicator and offset to use
150+
IF ( intercomm_active( grid%id ) ) THEN ! I am parent
151+
local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id )
152+
ioffset = nest_task_offsets(ngrid%id)
153+
ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest
154+
local_comm = mpi_comm_to_mom( ngrid%id )
155+
ioffset = nest_task_offsets(ngrid%id)
156+
END IF
157+
158+
IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN
159+
#ifndef STUBMPI
160+
CALL mpi_comm_rank(local_comm,myproc,ierr)
161+
CALL mpi_comm_size(local_comm,nproc,ierr)
162+
#endif
163+
!call tracebackqq()
164+
CALL rsl_lite_merge_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), &
165+
nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), &
166+
ioffset, local_comm )
167+
END IF
168+
169+
IF ( grid%active_this_task ) THEN
170+
CALL push_communicators_for_domain( grid%id )
171+
172+
173+
#define NEST_INFLUENCE(A,B) A = B
174+
#include "nest_feedbackup_unpack.inc"
175+
176+
! smooth coarse grid
177+
CALL get_ijk_from_grid ( ngrid, &
178+
nids, nide, njds, njde, nkds, nkde, &
179+
nims, nime, njms, njme, nkms, nkme, &
180+
nips, nipe, njps, njpe, nkps, nkpe )
181+
CALL get_ijk_from_grid ( grid , &
182+
ids, ide, jds, jde, kds, kde, &
183+
ims, ime, jms, jme, kms, kme, &
184+
ips, ipe, jps, jpe, kps, kpe )
185+
186+
#include "HALO_INTERP_UP.inc"
187+
188+
CALL get_ijk_from_grid ( grid , &
189+
cids, cide, cjds, cjde, ckds, ckde, &
190+
cims, cime, cjms, cjme, ckms, ckme, &
191+
cips, cipe, cjps, cjpe, ckps, ckpe )
192+
193+
#include "nest_feedbackup_smooth.inc"
194+
195+
CALL pop_communicators_for_domain
196+
END IF
197+
198+
RETURN
199+
END SUBROUTINE feedback_domain_em_part2
200+
#endif

0 commit comments

Comments
 (0)