MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_mpi_proxy.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
2!>
3!! @file
4!! @brief Contains module m_mpi_proxy
5
6!> @brief MPI gather and scatter operations for distributing post-process grid and flow-variable data
8
9#ifdef MFC_MPI
10 use mpi !< message passing interface (mpi) module
11#endif
12
15 use m_mpi_common
16 use ieee_arithmetic
17 use m_constants, only: format_silo
18
19 implicit none
20
21 !> @name Receive counts and displacement vector variables, respectively, used in enabling MPI to gather varying amounts of data
22 !! from all processes to the root process
23 !> @{
24 integer, allocatable, dimension(:) :: recvcounts
25 integer, allocatable, dimension(:) :: displs
26 !> @}
27
28contains
29
30 !> Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the module
32
33#ifdef MFC_MPI
34 integer :: i !< Generic loop iterator
35 integer :: ierr !< Generic flag used to identify and report MPI errors
36 ! Allocating and configuring the receive counts and the displacement vector variables used in variable-gather communication
37 ! procedures. Note that these are only needed for either multidimensional runs that utilize the Silo database file format or
38 ! for 1D simulations.
39
40 if ((format == format_silo .and. n > 0) .or. n == 0) then
41 allocate (recvcounts(0:num_procs - 1))
42 allocate (displs(0:num_procs - 1))
43
44 if (n == 0) then
45 call mpi_gather(m + 1, 1, mpi_integer, recvcounts(0), 1, mpi_integer, 0, mpi_comm_world, ierr)
46 else if (proc_rank == 0) then
47 recvcounts = 1
48 end if
49
50 if (proc_rank == 0) then
51 displs(0) = 0
52
53 do i = 1, num_procs - 1
54 displs(i) = displs(i - 1) + recvcounts(i - 1)
55 end do
56 end if
57 end if
58#endif
59
61
62 !> Since only processor with rank 0 is in charge of reading and checking the consistency of the user provided inputs, these are
63 !! not available to the remaining processors. This subroutine is then in charge of broadcasting the required information.
64 impure subroutine s_mpi_bcast_user_inputs
65
66#ifdef MFC_MPI
67 integer :: i !< Generic loop iterator
68 integer :: ierr !< Generic flag used to identify and report MPI errors
69
70 ! Generated: case_dir, namelist scalars (INT/LOG/REAL), array dims (including
71 ! chem_wrt_Y, previously missing), fluid_pp loop, bub_pp guard
72# 1 "/home/runner/work/MFC/MFC/build/include/post_process/generated_bcast.fpp" 1
73! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
74!
75 call mpi_bcast(case_dir, len(case_dir), mpi_character, 0, mpi_comm_world, ierr)
76
77 ! Integer scalars
78 call mpi_bcast(fd_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
79 call mpi_bcast(flux_lim, 1, mpi_integer, 0, mpi_comm_world, ierr)
80 call mpi_bcast(format, 1, mpi_integer, 0, mpi_comm_world, ierr)
81 call mpi_bcast(ib_force_stride, 1, mpi_integer, 0, mpi_comm_world, ierr)
82 call mpi_bcast(igr_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
83 call mpi_bcast(m, 1, mpi_integer, 0, mpi_comm_world, ierr)
84 call mpi_bcast(model_eqns, 1, mpi_integer, 0, mpi_comm_world, ierr)
85 call mpi_bcast(muscl_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
86 call mpi_bcast(n, 1, mpi_integer, 0, mpi_comm_world, ierr)
87 call mpi_bcast(n_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
88 call mpi_bcast(nb, 1, mpi_integer, 0, mpi_comm_world, ierr)
89 call mpi_bcast(num_fluids, 1, mpi_integer, 0, mpi_comm_world, ierr)
90 call mpi_bcast(num_ibs, 1, mpi_integer, 0, mpi_comm_world, ierr)
91 call mpi_bcast(num_particle_clouds, 1, mpi_integer, 0, mpi_comm_world, ierr)
92 call mpi_bcast(p, 1, mpi_integer, 0, mpi_comm_world, ierr)
93 call mpi_bcast(precision, 1, mpi_integer, 0, mpi_comm_world, ierr)
94 call mpi_bcast(recon_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
95 call mpi_bcast(relax_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
96 call mpi_bcast(t_step_save, 1, mpi_integer, 0, mpi_comm_world, ierr)
97 call mpi_bcast(t_step_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
98 call mpi_bcast(t_step_stop, 1, mpi_integer, 0, mpi_comm_world, ierr)
99 call mpi_bcast(thermal, 1, mpi_integer, 0, mpi_comm_world, ierr)
100 call mpi_bcast(weno_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
101
102 ! Logical scalars
103 call mpi_bcast(e_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
104 call mpi_bcast(t_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
105 call mpi_bcast(adv_n, 1, mpi_logical, 0, mpi_comm_world, ierr)
106 call mpi_bcast(alt_soundspeed, 1, mpi_logical, 0, mpi_comm_world, ierr)
107 call mpi_bcast(bubbles_euler, 1, mpi_logical, 0, mpi_comm_world, ierr)
108 call mpi_bcast(bubbles_lagrange, 1, mpi_logical, 0, mpi_comm_world, ierr)
109 call mpi_bcast(c_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
110 call mpi_bcast(cf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
111 call mpi_bcast(cfl_adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
112 call mpi_bcast(cfl_const_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
113 call mpi_bcast(chem_wrt_t, 1, mpi_logical, 0, mpi_comm_world, ierr)
114 call mpi_bcast(cons_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
115 call mpi_bcast(cont_damage, 1, mpi_logical, 0, mpi_comm_world, ierr)
116 call mpi_bcast(cyl_coord, 1, mpi_logical, 0, mpi_comm_world, ierr)
117 call mpi_bcast(down_sample, 1, mpi_logical, 0, mpi_comm_world, ierr)
118 call mpi_bcast(fft_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
119 call mpi_bcast(file_per_process, 1, mpi_logical, 0, mpi_comm_world, ierr)
120 call mpi_bcast(gamma_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
121 call mpi_bcast(heat_ratio_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
122 call mpi_bcast(hyper_cleaning, 1, mpi_logical, 0, mpi_comm_world, ierr)
123 call mpi_bcast(hypoelasticity, 1, mpi_logical, 0, mpi_comm_world, ierr)
124 call mpi_bcast(ib, 1, mpi_logical, 0, mpi_comm_world, ierr)
125 call mpi_bcast(ib_force_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
126 call mpi_bcast(ib_state_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
127 call mpi_bcast(igr, 1, mpi_logical, 0, mpi_comm_world, ierr)
128 call mpi_bcast(lag_betac_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
129 call mpi_bcast(lag_betat_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
130 call mpi_bcast(lag_db_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
131 call mpi_bcast(lag_dphidt_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
132 call mpi_bcast(lag_header, 1, mpi_logical, 0, mpi_comm_world, ierr)
133 call mpi_bcast(lag_id_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
134 call mpi_bcast(lag_mg_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
135 call mpi_bcast(lag_mv_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
136 call mpi_bcast(lag_pos_prev_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
137 call mpi_bcast(lag_pos_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
138 call mpi_bcast(lag_pres_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
139 call mpi_bcast(lag_r0_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
140 call mpi_bcast(lag_rad_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
141 call mpi_bcast(lag_rmax_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
142 call mpi_bcast(lag_rmin_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
143 call mpi_bcast(lag_rvel_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
144 call mpi_bcast(lag_txt_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
145 call mpi_bcast(lag_vel_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
146 call mpi_bcast(liutex_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
147 call mpi_bcast(mhd, 1, mpi_logical, 0, mpi_comm_world, ierr)
148 call mpi_bcast(mixture_err, 1, mpi_logical, 0, mpi_comm_world, ierr)
149 call mpi_bcast(mpp_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
150 call mpi_bcast(output_partial_domain, 1, mpi_logical, 0, mpi_comm_world, ierr)
151 call mpi_bcast(parallel_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
152 call mpi_bcast(pi_inf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
153 call mpi_bcast(polydisperse, 1, mpi_logical, 0, mpi_comm_world, ierr)
154 call mpi_bcast(polytropic, 1, mpi_logical, 0, mpi_comm_world, ierr)
155 call mpi_bcast(pres_inf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
156 call mpi_bcast(pres_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
157 call mpi_bcast(prim_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
158 call mpi_bcast(qbmm, 1, mpi_logical, 0, mpi_comm_world, ierr)
159 call mpi_bcast(qm_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
160 call mpi_bcast(reactive_burn, 1, mpi_logical, 0, mpi_comm_world, ierr)
161 call mpi_bcast(relativity, 1, mpi_logical, 0, mpi_comm_world, ierr)
162 call mpi_bcast(relax, 1, mpi_logical, 0, mpi_comm_world, ierr)
163 call mpi_bcast(rho_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
164 call mpi_bcast(schlieren_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
165 call mpi_bcast(sim_data, 1, mpi_logical, 0, mpi_comm_world, ierr)
166 call mpi_bcast(surface_tension, 1, mpi_logical, 0, mpi_comm_world, ierr)
167
168 ! Real scalars
169 call mpi_bcast(bx0, 1, mpi_p, 0, mpi_comm_world, ierr)
170 call mpi_bcast(ca, 1, mpi_p, 0, mpi_comm_world, ierr)
171 call mpi_bcast(r0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
172 call mpi_bcast(re_inv, 1, mpi_p, 0, mpi_comm_world, ierr)
173 call mpi_bcast(web, 1, mpi_p, 0, mpi_comm_world, ierr)
174 call mpi_bcast(poly_sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
175 call mpi_bcast(sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
176 call mpi_bcast(t_save, 1, mpi_p, 0, mpi_comm_world, ierr)
177 call mpi_bcast(t_stop, 1, mpi_p, 0, mpi_comm_world, ierr)
178
179 ! Array broadcasts (dimension from FORTRAN_ARRAY_DIMS)
180 call mpi_bcast(alpha_rho_e_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
181 call mpi_bcast(alpha_rho_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
182 call mpi_bcast(alpha_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
183 call mpi_bcast(chem_wrt_y(1), num_species, mpi_logical, 0, mpi_comm_world, ierr)
184 call mpi_bcast(flux_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
185 call mpi_bcast(mom_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
186 call mpi_bcast(omega_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
187 call mpi_bcast(schlieren_alpha(1), num_fluids_max, mpi_p, 0, mpi_comm_world, ierr)
188 call mpi_bcast(vel_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
189
190 ! fluid_pp member loop
191 do i = 1, num_fluids_max
192 call mpi_bcast(fluid_pp(i)%G, 1, mpi_p, 0, mpi_comm_world, ierr)
193 call mpi_bcast(fluid_pp(i)%K, 1, mpi_p, 0, mpi_comm_world, ierr)
194 call mpi_bcast(fluid_pp(i)%cv, 1, mpi_p, 0, mpi_comm_world, ierr)
195 call mpi_bcast(fluid_pp(i)%eos, 1, mpi_integer, 0, mpi_comm_world, ierr)
196 call mpi_bcast(fluid_pp(i)%gamma, 1, mpi_p, 0, mpi_comm_world, ierr)
197 call mpi_bcast(fluid_pp(i)%hb_m, 1, mpi_p, 0, mpi_comm_world, ierr)
198 call mpi_bcast(fluid_pp(i)%jwl_a, 1, mpi_p, 0, mpi_comm_world, ierr)
199 call mpi_bcast(fluid_pp(i)%jwl_b, 1, mpi_p, 0, mpi_comm_world, ierr)
200 call mpi_bcast(fluid_pp(i)%jwl_omega, 1, mpi_p, 0, mpi_comm_world, ierr)
201 call mpi_bcast(fluid_pp(i)%jwl_r1, 1, mpi_p, 0, mpi_comm_world, ierr)
202 call mpi_bcast(fluid_pp(i)%jwl_r2, 1, mpi_p, 0, mpi_comm_world, ierr)
203 call mpi_bcast(fluid_pp(i)%jwl_rho0, 1, mpi_p, 0, mpi_comm_world, ierr)
204 call mpi_bcast(fluid_pp(i)%jwl_t0, 1, mpi_p, 0, mpi_comm_world, ierr)
205 call mpi_bcast(fluid_pp(i)%k_therm, 1, mpi_p, 0, mpi_comm_world, ierr)
206 call mpi_bcast(fluid_pp(i)%mg_c0, 1, mpi_p, 0, mpi_comm_world, ierr)
207 call mpi_bcast(fluid_pp(i)%mg_gruneisen, 1, mpi_p, 0, mpi_comm_world, ierr)
208 call mpi_bcast(fluid_pp(i)%mg_gruneisen_a, 1, mpi_p, 0, mpi_comm_world, ierr)
209 call mpi_bcast(fluid_pp(i)%mg_rho0, 1, mpi_p, 0, mpi_comm_world, ierr)
210 call mpi_bcast(fluid_pp(i)%mg_s, 1, mpi_p, 0, mpi_comm_world, ierr)
211 call mpi_bcast(fluid_pp(i)%mg_s2, 1, mpi_p, 0, mpi_comm_world, ierr)
212 call mpi_bcast(fluid_pp(i)%mg_s3, 1, mpi_p, 0, mpi_comm_world, ierr)
213 call mpi_bcast(fluid_pp(i)%mg_t0, 1, mpi_p, 0, mpi_comm_world, ierr)
214 call mpi_bcast(fluid_pp(i)%mu_bulk, 1, mpi_p, 0, mpi_comm_world, ierr)
215 call mpi_bcast(fluid_pp(i)%mu_max, 1, mpi_p, 0, mpi_comm_world, ierr)
216 call mpi_bcast(fluid_pp(i)%mu_min, 1, mpi_p, 0, mpi_comm_world, ierr)
217 call mpi_bcast(fluid_pp(i)%nn, 1, mpi_p, 0, mpi_comm_world, ierr)
218 call mpi_bcast(fluid_pp(i)%non_newtonian, 1, mpi_logical, 0, mpi_comm_world, ierr)
219 call mpi_bcast(fluid_pp(i)%pi_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
220 call mpi_bcast(fluid_pp(i)%qv, 1, mpi_p, 0, mpi_comm_world, ierr)
221 call mpi_bcast(fluid_pp(i)%qvp, 1, mpi_p, 0, mpi_comm_world, ierr)
222 call mpi_bcast(fluid_pp(i)%tau0, 1, mpi_p, 0, mpi_comm_world, ierr)
223 call mpi_bcast(fluid_pp(i)%vinet_gruneisen, 1, mpi_p, 0, mpi_comm_world, ierr)
224 call mpi_bcast(fluid_pp(i)%vinet_gruneisen_a, 1, mpi_p, 0, mpi_comm_world, ierr)
225 call mpi_bcast(fluid_pp(i)%vinet_k0, 1, mpi_p, 0, mpi_comm_world, ierr)
226 call mpi_bcast(fluid_pp(i)%vinet_k0p, 1, mpi_p, 0, mpi_comm_world, ierr)
227 call mpi_bcast(fluid_pp(i)%vinet_rho0, 1, mpi_p, 0, mpi_comm_world, ierr)
228 call mpi_bcast(fluid_pp(i)%vinet_t0, 1, mpi_p, 0, mpi_comm_world, ierr)
229 end do
230
231 ! bub_pp members (under bubbles guard)
232 if (bubbles_euler .or. bubbles_lagrange) then
233 call mpi_bcast(bub_pp%M_g, 1, mpi_p, 0, mpi_comm_world, ierr)
234 call mpi_bcast(bub_pp%M_v, 1, mpi_p, 0, mpi_comm_world, ierr)
235 call mpi_bcast(bub_pp%R0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
236 call mpi_bcast(bub_pp%R_g, 1, mpi_p, 0, mpi_comm_world, ierr)
237 call mpi_bcast(bub_pp%R_v, 1, mpi_p, 0, mpi_comm_world, ierr)
238 call mpi_bcast(bub_pp%T0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
239 call mpi_bcast(bub_pp%cp_g, 1, mpi_p, 0, mpi_comm_world, ierr)
240 call mpi_bcast(bub_pp%cp_v, 1, mpi_p, 0, mpi_comm_world, ierr)
241 call mpi_bcast(bub_pp%gam_g, 1, mpi_p, 0, mpi_comm_world, ierr)
242 call mpi_bcast(bub_pp%gam_v, 1, mpi_p, 0, mpi_comm_world, ierr)
243 call mpi_bcast(bub_pp%k_g, 1, mpi_p, 0, mpi_comm_world, ierr)
244 call mpi_bcast(bub_pp%k_v, 1, mpi_p, 0, mpi_comm_world, ierr)
245 call mpi_bcast(bub_pp%mu_g, 1, mpi_p, 0, mpi_comm_world, ierr)
246 call mpi_bcast(bub_pp%mu_l, 1, mpi_p, 0, mpi_comm_world, ierr)
247 call mpi_bcast(bub_pp%mu_v, 1, mpi_p, 0, mpi_comm_world, ierr)
248 call mpi_bcast(bub_pp%p0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
249 call mpi_bcast(bub_pp%pv, 1, mpi_p, 0, mpi_comm_world, ierr)
250 call mpi_bcast(bub_pp%rho0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
251 call mpi_bcast(bub_pp%ss, 1, mpi_p, 0, mpi_comm_world, ierr)
252 call mpi_bcast(bub_pp%vd, 1, mpi_p, 0, mpi_comm_world, ierr)
253 end if
254
255# 72 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp" 2
256
257 ! manual: m_glb, n_glb, p_glb (computed in s_read_input_file, not namelist-bound)
258 call mpi_bcast(m_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
259 call mpi_bcast(n_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
260 call mpi_bcast(p_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
261
262 ! manual: bc_x/y/z member broadcasts (struct members not in NAMELIST_VARS)
263# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
264 call mpi_bcast(bc_x%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
265# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
266 call mpi_bcast(bc_x%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
267# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
268 call mpi_bcast(bc_y%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
269# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
270 call mpi_bcast(bc_y%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
271# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
272 call mpi_bcast(bc_z%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
273# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
274 call mpi_bcast(bc_z%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
275# 82 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
276
277# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
278 call mpi_bcast(bc_x%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
279# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
280 call mpi_bcast(bc_y%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
281# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
282 call mpi_bcast(bc_z%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
283# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
284 call mpi_bcast(bc_x%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
285# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
286 call mpi_bcast(bc_y%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
287# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
288 call mpi_bcast(bc_z%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
289# 87 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
290
291 ! wall-velocity members consumed by s_slip_wall/s_no_slip_wall on all ranks
292# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
293# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
294 call mpi_bcast(bc_x%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
295 call mpi_bcast(bc_x%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
296# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
297 call mpi_bcast(bc_x%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
298 call mpi_bcast(bc_x%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
299# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
300 call mpi_bcast(bc_x%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
301 call mpi_bcast(bc_x%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
302# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
303# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
304# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
305 call mpi_bcast(bc_y%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
306 call mpi_bcast(bc_y%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
307# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
308 call mpi_bcast(bc_y%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
309 call mpi_bcast(bc_y%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
310# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
311 call mpi_bcast(bc_y%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
312 call mpi_bcast(bc_y%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
313# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
314# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
315# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
316 call mpi_bcast(bc_z%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
317 call mpi_bcast(bc_z%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
318# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
319 call mpi_bcast(bc_z%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
320 call mpi_bcast(bc_z%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
321# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
322 call mpi_bcast(bc_z%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
323 call mpi_bcast(bc_z%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
324# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
325# 95 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
326
327 ! manual: particle_cloud (runtime loop to num_particle_clouds; irregular member subset)
328 do i = 1, num_particle_clouds
329# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
330 call mpi_bcast(particle_cloud(i)%x_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
331# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
332 call mpi_bcast(particle_cloud(i)%y_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
333# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
334 call mpi_bcast(particle_cloud(i)%z_centroid, 1, mpi_p, 0, mpi_comm_world, ierr)
335# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
336 call mpi_bcast(particle_cloud(i)%length_x, 1, mpi_p, 0, mpi_comm_world, ierr)
337# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
338 call mpi_bcast(particle_cloud(i)%length_y, 1, mpi_p, 0, mpi_comm_world, ierr)
339# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
340 call mpi_bcast(particle_cloud(i)%length_z, 1, mpi_p, 0, mpi_comm_world, ierr)
341# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
342 call mpi_bcast(particle_cloud(i)%radius, 1, mpi_p, 0, mpi_comm_world, ierr)
343# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
344 call mpi_bcast(particle_cloud(i)%mass, 1, mpi_p, 0, mpi_comm_world, ierr)
345# 100 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
346 call mpi_bcast(particle_cloud(i)%min_spacing, 1, mpi_p, 0, mpi_comm_world, ierr)
347# 102 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
348 call mpi_bcast(particle_cloud(i)%num_particles, 1, mpi_integer, 0, mpi_comm_world, ierr)
349 call mpi_bcast(particle_cloud(i)%moving_ibm, 1, mpi_integer, 0, mpi_comm_world, ierr)
350 call mpi_bcast(particle_cloud(i)%seed, 1, mpi_integer, 0, mpi_comm_world, ierr)
351 call mpi_bcast(particle_cloud(i)%packing_method, 1, mpi_integer, 0, mpi_comm_world, ierr)
352 end do
353
354 ! manual: cfl_dt (runtime-computed logical), bc_io (BC-file existence)
355 call mpi_bcast(cfl_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
356 call mpi_bcast(bc_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
357
358 ! manual: output domain and Twall bc members (struct members not in NAMELIST_VARS)
359# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
360 call mpi_bcast(x_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
361# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
362 call mpi_bcast(x_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
363# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
364 call mpi_bcast(y_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
365# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
366 call mpi_bcast(y_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
367# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
368 call mpi_bcast(z_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
369# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
370 call mpi_bcast(z_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
371# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
372 call mpi_bcast(bc_x%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
373# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
374 call mpi_bcast(bc_x%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
375# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
376 call mpi_bcast(bc_y%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
377# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
378 call mpi_bcast(bc_y%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
379# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
380 call mpi_bcast(bc_z%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
381# 117 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
382 call mpi_bcast(bc_z%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
383# 119 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
384#endif
385
386 end subroutine s_mpi_bcast_user_inputs
387
388 !> Gather spatial extents from all ranks for Silo database metadata
389 impure subroutine s_mpi_gather_spatial_extents(spatial_extents)
390
391 real(wp), dimension(1:,0:), intent(inout) :: spatial_extents
392
393#ifdef MFC_MPI
394 integer :: ierr !< Generic flag used to identify and report MPI errors
395 real(wp) :: ext_temp(0:num_procs - 1)
396
397 ! Simulation is 3D
398
399 if (p > 0) then
400 if (grid_geometry == 3) then
401 ! Minimum spatial extent in the r-direction
402 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
403 & ierr)
404
405 ! Minimum spatial extent in the theta-direction
406 call mpi_gatherv(minval(z_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
407 & ierr)
408
409 ! Minimum spatial extent in the z-direction
410 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
411 & ierr)
412
413 ! Maximum spatial extent in the r-direction
414 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
415 & ierr)
416
417 ! Maximum spatial extent in the theta-direction
418 call mpi_gatherv(maxval(z_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
419 & ierr)
420
421 ! Maximum spatial extent in the z-direction
422 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
423 & ierr)
424 else
425 ! Minimum spatial extent in the x-direction
426 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
427 & ierr)
428
429 ! Minimum spatial extent in the y-direction
430 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
431 & ierr)
432
433 ! Minimum spatial extent in the z-direction
434 call mpi_gatherv(minval(z_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
435 & ierr)
436
437 ! Maximum spatial extent in the x-direction
438 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
439 & ierr)
440
441 ! Maximum spatial extent in the y-direction
442 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
443 & ierr)
444
445 ! Maximum spatial extent in the z-direction
446 call mpi_gatherv(maxval(z_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
447 & ierr)
448 end if
449 ! Simulation is 2D
450 else if (n > 0) then
451 ! Minimum spatial extent in the x-direction
452 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
453
454 ! Minimum spatial extent in the y-direction
455 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
456
457 ! Maximum spatial extent in the x-direction
458 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
459
460 ! Maximum spatial extent in the y-direction
461 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
462 ! Simulation is 1D
463 else
464 ! For 1D, recvcounts/displs are sized for grid defragmentation (m+1 per rank), not for scalar gathers. Use MPI_GATHER
465 ! instead.
466
467 ! Minimum spatial extent in the x-direction
468 call mpi_gather(minval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
469 if (proc_rank == 0) spatial_extents(1,:) = ext_temp
470
471 ! Maximum spatial extent in the x-direction
472 call mpi_gather(maxval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
473 if (proc_rank == 0) spatial_extents(2,:) = ext_temp
474 end if
475#endif
476
477 end subroutine s_mpi_gather_spatial_extents
478
479 !> Collect the sub-domain cell-boundary or cell-center location data from all processors and put back together the grid of the
480 !! entire computational domain on the rank 0 processor. This is only done for 1D simulations.
482
483#ifdef MFC_MPI
484 integer :: ierr !< Generic flag used to identify and report MPI errors
485 ! Silo-HDF5 database format
486
487 if (format == format_silo) then
488 call mpi_gatherv(x_cc(0), m + 1, mpi_p, x_root_cc(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
489
490 ! Binary database format
491 else
492 call mpi_gatherv(x_cb(0), m + 1, mpi_p, x_root_cb(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
493
494 if (proc_rank == 0) x_root_cb(-1) = x_cb(-1)
495 end if
496#endif
497
499
500 !> Gather the Silo database metadata for the flow variable's extents to boost performance of the multidimensional visualization.
501 !! @param q_sf Flow variable on a single computational sub-domain
502 impure subroutine s_mpi_gather_data_extents(q_sf, data_extents)
503
504 real(wp), dimension(:,:,:), intent(in) :: q_sf
505 real(wp), dimension(1:2,0:num_procs - 1), intent(inout) :: data_extents
506
507#ifdef MFC_MPI
508 integer :: ierr !< Generic flag used to identify and report MPI errors
509 real(wp) :: ext_temp(0:num_procs - 1)
510
511 if (n > 0) then
512 ! Multi-D: recvcounts = 1, so strided MPI_GATHERV works correctly Minimum flow variable extent
513 call mpi_gatherv(minval(q_sf), 1, mpi_p, data_extents(1, 0), recvcounts, 2*displs, mpi_p, 0, mpi_comm_world, ierr)
514
515 ! Maximum flow variable extent
516 call mpi_gatherv(maxval(q_sf), 1, mpi_p, data_extents(2, 0), recvcounts, 2*displs, mpi_p, 0, mpi_comm_world, ierr)
517 else
518 ! 1D: recvcounts/displs are sized for grid defragmentation (m+1 per rank), not for scalar gathers. Use MPI_GATHER
519 ! instead.
520
521 ! Minimum flow variable extent
522 call mpi_gather(minval(q_sf), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
523 if (proc_rank == 0) data_extents(1,:) = ext_temp
524
525 ! Maximum flow variable extent
526 call mpi_gather(maxval(q_sf), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
527 if (proc_rank == 0) data_extents(2,:) = ext_temp
528 end if
529#endif
530
531 end subroutine s_mpi_gather_data_extents
532
533 !> Gather the sub-domain flow variable data from all processors and reassemble it for the entire computational domain on the
534 !! rank 0 processor. This is only done for 1D simulations.
535 !! @param q_sf Flow variable on a single computational sub-domain
536 !! @param q_root_sf Flow variable on the entire computational domain
537 impure subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf)
538
539 real(wp), dimension(0:m), intent(in) :: q_sf
540 real(wp), dimension(0:m), intent(inout) :: q_root_sf
541
542#ifdef MFC_MPI
543 integer :: ierr !< Generic flag used to identify and report MPI errors
544 ! Gathering the sub-domain flow variable data from all the processes and putting it back together for the entire
545 ! computational domain on the process with rank 0
546
547 call mpi_gatherv(q_sf(0), m + 1, mpi_p, q_root_sf(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
548#endif
549
551
552 !> Deallocation procedures for the module
554
555#ifdef MFC_MPI
556 ! Deallocating the receive counts and the displacement vector variables used in variable-gather communication procedures
557 if ((format == format_silo .and. n > 0) .or. n == 0) then
558 deallocate (recvcounts)
559 deallocate (displs)
560 end if
561#endif
562
563 end subroutine s_finalize_mpi_proxy_module
564
565end module m_mpi_proxy
Compile-time constant parameters: default values, tolerances, and physical constants.
integer, parameter format_silo
integer, parameter num_fluids_max
Maximum number of fluids in the simulation.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
integer proc_rank
Rank of the local processor.
real(wp), dimension(:), allocatable x_root_cc
real(wp), dimension(:), allocatable y_cb
real(wp), dimension(:), allocatable x_root_cb
real(wp), dimension(:), allocatable z_cb
type(bounds_info) z_output
Portion of domain to output for post-processing.
real(wp), dimension(:), allocatable x_cc
real(wp), dimension(:), allocatable x_cb
integer num_procs
Number of processors.
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
impure subroutine s_initialize_mpi_proxy_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
integer, dimension(:), allocatable recvcounts
impure subroutine s_mpi_defragment_1d_grid_variable
Collect the sub-domain cell-boundary or cell-center location data from all processors and put back to...
impure subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf)
Gather the sub-domain flow variable data from all processors and reassemble it for the entire computa...
impure subroutine s_mpi_gather_spatial_extents(spatial_extents)
Gather spatial extents from all ranks for Silo database metadata.
impure subroutine s_mpi_bcast_user_inputs
Since only processor with rank 0 is in charge of reading and checking the consistency of the user pro...
impure subroutine s_mpi_gather_data_extents(q_sf, data_extents)
Gather the Silo database metadata for the flow variable's extents to boost performance of the multidi...
impure subroutine s_finalize_mpi_proxy_module
Deallocation procedures for the module.
integer, dimension(:), allocatable displs