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
7module m_mpi_proxy
8
9#ifdef MFC_MPI
10 use mpi !< message passing interface (mpi) module
11#endif
12
13 use m_derived_types
14 use m_global_parameters
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
31 impure subroutine s_initialize_mpi_proxy_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
60 end subroutine s_initialize_mpi_proxy_module
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(igr_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
82 call mpi_bcast(m, 1, mpi_integer, 0, mpi_comm_world, ierr)
83 call mpi_bcast(model_eqns, 1, mpi_integer, 0, mpi_comm_world, ierr)
84 call mpi_bcast(muscl_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
85 call mpi_bcast(n, 1, mpi_integer, 0, mpi_comm_world, ierr)
86 call mpi_bcast(n_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
87 call mpi_bcast(nb, 1, mpi_integer, 0, mpi_comm_world, ierr)
88 call mpi_bcast(num_fluids, 1, mpi_integer, 0, mpi_comm_world, ierr)
89 call mpi_bcast(num_ibs, 1, mpi_integer, 0, mpi_comm_world, ierr)
90 call mpi_bcast(p, 1, mpi_integer, 0, mpi_comm_world, ierr)
91 call mpi_bcast(precision, 1, mpi_integer, 0, mpi_comm_world, ierr)
92 call mpi_bcast(recon_type, 1, mpi_integer, 0, mpi_comm_world, ierr)
93 call mpi_bcast(relax_model, 1, mpi_integer, 0, mpi_comm_world, ierr)
94 call mpi_bcast(t_step_save, 1, mpi_integer, 0, mpi_comm_world, ierr)
95 call mpi_bcast(t_step_start, 1, mpi_integer, 0, mpi_comm_world, ierr)
96 call mpi_bcast(t_step_stop, 1, mpi_integer, 0, mpi_comm_world, ierr)
97 call mpi_bcast(thermal, 1, mpi_integer, 0, mpi_comm_world, ierr)
98 call mpi_bcast(weno_order, 1, mpi_integer, 0, mpi_comm_world, ierr)
99
100 ! Logical scalars
101 call mpi_bcast(e_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
102 call mpi_bcast(adv_n, 1, mpi_logical, 0, mpi_comm_world, ierr)
103 call mpi_bcast(alt_soundspeed, 1, mpi_logical, 0, mpi_comm_world, ierr)
104 call mpi_bcast(bubbles_euler, 1, mpi_logical, 0, mpi_comm_world, ierr)
105 call mpi_bcast(bubbles_lagrange, 1, mpi_logical, 0, mpi_comm_world, ierr)
106 call mpi_bcast(c_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
107 call mpi_bcast(cf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
108 call mpi_bcast(cfl_adap_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
109 call mpi_bcast(cfl_const_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
110 call mpi_bcast(chem_wrt_t, 1, mpi_logical, 0, mpi_comm_world, ierr)
111 call mpi_bcast(cons_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
112 call mpi_bcast(cont_damage, 1, mpi_logical, 0, mpi_comm_world, ierr)
113 call mpi_bcast(cyl_coord, 1, mpi_logical, 0, mpi_comm_world, ierr)
114 call mpi_bcast(down_sample, 1, mpi_logical, 0, mpi_comm_world, ierr)
115 call mpi_bcast(fft_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
116 call mpi_bcast(file_per_process, 1, mpi_logical, 0, mpi_comm_world, ierr)
117 call mpi_bcast(gamma_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
118 call mpi_bcast(heat_ratio_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
119 call mpi_bcast(hyper_cleaning, 1, mpi_logical, 0, mpi_comm_world, ierr)
120 call mpi_bcast(hyperelasticity, 1, mpi_logical, 0, mpi_comm_world, ierr)
121 call mpi_bcast(hypoelasticity, 1, mpi_logical, 0, mpi_comm_world, ierr)
122 call mpi_bcast(ib, 1, mpi_logical, 0, mpi_comm_world, ierr)
123 call mpi_bcast(ib_state_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
124 call mpi_bcast(igr, 1, mpi_logical, 0, mpi_comm_world, ierr)
125 call mpi_bcast(lag_betac_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
126 call mpi_bcast(lag_betat_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
127 call mpi_bcast(lag_db_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
128 call mpi_bcast(lag_dphidt_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
129 call mpi_bcast(lag_header, 1, mpi_logical, 0, mpi_comm_world, ierr)
130 call mpi_bcast(lag_id_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
131 call mpi_bcast(lag_mg_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
132 call mpi_bcast(lag_mv_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
133 call mpi_bcast(lag_pos_prev_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
134 call mpi_bcast(lag_pos_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
135 call mpi_bcast(lag_pres_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
136 call mpi_bcast(lag_r0_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
137 call mpi_bcast(lag_rad_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
138 call mpi_bcast(lag_rmax_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
139 call mpi_bcast(lag_rmin_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
140 call mpi_bcast(lag_rvel_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
141 call mpi_bcast(lag_txt_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
142 call mpi_bcast(lag_vel_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
143 call mpi_bcast(liutex_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
144 call mpi_bcast(mhd, 1, mpi_logical, 0, mpi_comm_world, ierr)
145 call mpi_bcast(mixture_err, 1, mpi_logical, 0, mpi_comm_world, ierr)
146 call mpi_bcast(mpp_lim, 1, mpi_logical, 0, mpi_comm_world, ierr)
147 call mpi_bcast(output_partial_domain, 1, mpi_logical, 0, mpi_comm_world, ierr)
148 call mpi_bcast(parallel_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
149 call mpi_bcast(pi_inf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
150 call mpi_bcast(polydisperse, 1, mpi_logical, 0, mpi_comm_world, ierr)
151 call mpi_bcast(polytropic, 1, mpi_logical, 0, mpi_comm_world, ierr)
152 call mpi_bcast(pres_inf_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
153 call mpi_bcast(pres_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
154 call mpi_bcast(prim_vars_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
155 call mpi_bcast(qbmm, 1, mpi_logical, 0, mpi_comm_world, ierr)
156 call mpi_bcast(qm_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
157 call mpi_bcast(relativity, 1, mpi_logical, 0, mpi_comm_world, ierr)
158 call mpi_bcast(relax, 1, mpi_logical, 0, mpi_comm_world, ierr)
159 call mpi_bcast(rho_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
160 call mpi_bcast(schlieren_wrt, 1, mpi_logical, 0, mpi_comm_world, ierr)
161 call mpi_bcast(sim_data, 1, mpi_logical, 0, mpi_comm_world, ierr)
162 call mpi_bcast(surface_tension, 1, mpi_logical, 0, mpi_comm_world, ierr)
163
164 ! Real scalars
165 call mpi_bcast(bx0, 1, mpi_p, 0, mpi_comm_world, ierr)
166 call mpi_bcast(ca, 1, mpi_p, 0, mpi_comm_world, ierr)
167 call mpi_bcast(r0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
168 call mpi_bcast(re_inv, 1, mpi_p, 0, mpi_comm_world, ierr)
169 call mpi_bcast(web, 1, mpi_p, 0, mpi_comm_world, ierr)
170 call mpi_bcast(poly_sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
171 call mpi_bcast(pref, 1, mpi_p, 0, mpi_comm_world, ierr)
172 call mpi_bcast(rhoref, 1, mpi_p, 0, mpi_comm_world, ierr)
173 call mpi_bcast(sigma, 1, mpi_p, 0, mpi_comm_world, ierr)
174 call mpi_bcast(t_save, 1, mpi_p, 0, mpi_comm_world, ierr)
175 call mpi_bcast(t_stop, 1, mpi_p, 0, mpi_comm_world, ierr)
176
177 ! Array broadcasts (dimension from FORTRAN_ARRAY_DIMS)
178 call mpi_bcast(alpha_rho_e_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
179 call mpi_bcast(alpha_rho_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
180 call mpi_bcast(alpha_wrt(1), num_fluids_max, mpi_logical, 0, mpi_comm_world, ierr)
181 call mpi_bcast(chem_wrt_y(1), num_species, mpi_logical, 0, mpi_comm_world, ierr)
182 call mpi_bcast(flux_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
183 call mpi_bcast(mom_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
184 call mpi_bcast(omega_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
185 call mpi_bcast(schlieren_alpha(1), num_fluids_max, mpi_p, 0, mpi_comm_world, ierr)
186 call mpi_bcast(vel_wrt(1), 3, mpi_logical, 0, mpi_comm_world, ierr)
187
188 ! fluid_pp member loop
189 do i = 1, num_fluids_max
190 call mpi_bcast(fluid_pp(i)%G, 1, mpi_p, 0, mpi_comm_world, ierr)
191 call mpi_bcast(fluid_pp(i)%K, 1, mpi_p, 0, mpi_comm_world, ierr)
192 call mpi_bcast(fluid_pp(i)%cv, 1, mpi_p, 0, mpi_comm_world, ierr)
193 call mpi_bcast(fluid_pp(i)%gamma, 1, mpi_p, 0, mpi_comm_world, ierr)
194 call mpi_bcast(fluid_pp(i)%hb_m, 1, mpi_p, 0, mpi_comm_world, ierr)
195 call mpi_bcast(fluid_pp(i)%mu_bulk, 1, mpi_p, 0, mpi_comm_world, ierr)
196 call mpi_bcast(fluid_pp(i)%mu_max, 1, mpi_p, 0, mpi_comm_world, ierr)
197 call mpi_bcast(fluid_pp(i)%mu_min, 1, mpi_p, 0, mpi_comm_world, ierr)
198 call mpi_bcast(fluid_pp(i)%nn, 1, mpi_p, 0, mpi_comm_world, ierr)
199 call mpi_bcast(fluid_pp(i)%non_newtonian, 1, mpi_logical, 0, mpi_comm_world, ierr)
200 call mpi_bcast(fluid_pp(i)%pi_inf, 1, mpi_p, 0, mpi_comm_world, ierr)
201 call mpi_bcast(fluid_pp(i)%qv, 1, mpi_p, 0, mpi_comm_world, ierr)
202 call mpi_bcast(fluid_pp(i)%qvp, 1, mpi_p, 0, mpi_comm_world, ierr)
203 call mpi_bcast(fluid_pp(i)%tau0, 1, mpi_p, 0, mpi_comm_world, ierr)
204 end do
205
206 ! bub_pp members (under bubbles guard)
207 if (bubbles_euler .or. bubbles_lagrange) then
208 call mpi_bcast(bub_pp%M_g, 1, mpi_p, 0, mpi_comm_world, ierr)
209 call mpi_bcast(bub_pp%M_v, 1, mpi_p, 0, mpi_comm_world, ierr)
210 call mpi_bcast(bub_pp%R0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
211 call mpi_bcast(bub_pp%R_g, 1, mpi_p, 0, mpi_comm_world, ierr)
212 call mpi_bcast(bub_pp%R_v, 1, mpi_p, 0, mpi_comm_world, ierr)
213 call mpi_bcast(bub_pp%T0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
214 call mpi_bcast(bub_pp%cp_g, 1, mpi_p, 0, mpi_comm_world, ierr)
215 call mpi_bcast(bub_pp%cp_v, 1, mpi_p, 0, mpi_comm_world, ierr)
216 call mpi_bcast(bub_pp%gam_g, 1, mpi_p, 0, mpi_comm_world, ierr)
217 call mpi_bcast(bub_pp%gam_v, 1, mpi_p, 0, mpi_comm_world, ierr)
218 call mpi_bcast(bub_pp%k_g, 1, mpi_p, 0, mpi_comm_world, ierr)
219 call mpi_bcast(bub_pp%k_v, 1, mpi_p, 0, mpi_comm_world, ierr)
220 call mpi_bcast(bub_pp%mu_g, 1, mpi_p, 0, mpi_comm_world, ierr)
221 call mpi_bcast(bub_pp%mu_l, 1, mpi_p, 0, mpi_comm_world, ierr)
222 call mpi_bcast(bub_pp%mu_v, 1, mpi_p, 0, mpi_comm_world, ierr)
223 call mpi_bcast(bub_pp%p0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
224 call mpi_bcast(bub_pp%pv, 1, mpi_p, 0, mpi_comm_world, ierr)
225 call mpi_bcast(bub_pp%rho0ref, 1, mpi_p, 0, mpi_comm_world, ierr)
226 call mpi_bcast(bub_pp%ss, 1, mpi_p, 0, mpi_comm_world, ierr)
227 call mpi_bcast(bub_pp%vd, 1, mpi_p, 0, mpi_comm_world, ierr)
228 end if
229
230# 72 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp" 2
231
232 ! manual: m_glb, n_glb, p_glb (computed in s_read_input_file, not namelist-bound)
233 call mpi_bcast(m_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
234 call mpi_bcast(n_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
235 call mpi_bcast(p_glb, 1, mpi_integer, 0, mpi_comm_world, ierr)
236
237 ! manual: bc_x/y/z member broadcasts (struct members not in NAMELIST_VARS)
238# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
239 call mpi_bcast(bc_x%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
240# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
241 call mpi_bcast(bc_x%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
242# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
243 call mpi_bcast(bc_y%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
244# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
245 call mpi_bcast(bc_y%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
246# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
247 call mpi_bcast(bc_z%beg, 1, mpi_integer, 0, mpi_comm_world, ierr)
248# 80 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
249 call mpi_bcast(bc_z%end, 1, mpi_integer, 0, mpi_comm_world, ierr)
250# 82 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
251
252# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
253 call mpi_bcast(bc_x%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
254# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
255 call mpi_bcast(bc_y%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
256# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
257 call mpi_bcast(bc_z%isothermal_in, 1, mpi_logical, 0, mpi_comm_world, ierr)
258# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
259 call mpi_bcast(bc_x%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
260# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
261 call mpi_bcast(bc_y%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
262# 85 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
263 call mpi_bcast(bc_z%isothermal_out, 1, mpi_logical, 0, mpi_comm_world, ierr)
264# 87 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
265
266 ! wall-velocity members consumed by s_slip_wall/s_no_slip_wall on all ranks
267# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
268# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
269 call mpi_bcast(bc_x%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
270 call mpi_bcast(bc_x%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
271# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
272 call mpi_bcast(bc_x%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
273 call mpi_bcast(bc_x%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
274# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
275 call mpi_bcast(bc_x%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
276 call mpi_bcast(bc_x%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
277# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
278# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
279# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
280 call mpi_bcast(bc_y%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
281 call mpi_bcast(bc_y%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
282# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
283 call mpi_bcast(bc_y%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
284 call mpi_bcast(bc_y%ve2, 1, mpi_p, 0, mpi_comm_world, ierr)
285# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
286 call mpi_bcast(bc_y%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
287 call mpi_bcast(bc_y%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
288# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
289# 90 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
290# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
291 call mpi_bcast(bc_z%vb1, 1, mpi_p, 0, mpi_comm_world, ierr)
292 call mpi_bcast(bc_z%ve1, 1, mpi_p, 0, mpi_comm_world, ierr)
293# 91 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
294 call mpi_bcast(bc_z%vb2, 1, mpi_p, 0, mpi_comm_world, ierr)
295 call mpi_bcast(bc_z%ve2, 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_z%vb3, 1, mpi_p, 0, mpi_comm_world, ierr)
298 call mpi_bcast(bc_z%ve3, 1, mpi_p, 0, mpi_comm_world, ierr)
299# 94 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
300# 95 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
301
302 ! manual: cfl_dt (runtime-computed logical), bc_io (BC-file existence)
303 call mpi_bcast(cfl_dt, 1, mpi_logical, 0, mpi_comm_world, ierr)
304 call mpi_bcast(bc_io, 1, mpi_logical, 0, mpi_comm_world, ierr)
305
306 ! manual: output domain and Twall bc members (struct members not in NAMELIST_VARS)
307# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
308 call mpi_bcast(x_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
309# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
310 call mpi_bcast(x_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
311# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
312 call mpi_bcast(y_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
313# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
314 call mpi_bcast(y_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
315# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
316 call mpi_bcast(z_output%beg, 1, mpi_p, 0, mpi_comm_world, ierr)
317# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
318 call mpi_bcast(z_output%end, 1, mpi_p, 0, mpi_comm_world, ierr)
319# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
320 call mpi_bcast(bc_x%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
321# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
322 call mpi_bcast(bc_x%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
323# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
324 call mpi_bcast(bc_y%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
325# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
326 call mpi_bcast(bc_y%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
327# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
328 call mpi_bcast(bc_z%Twall_in, 1, mpi_p, 0, mpi_comm_world, ierr)
329# 105 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
330 call mpi_bcast(bc_z%Twall_out, 1, mpi_p, 0, mpi_comm_world, ierr)
331# 107 "/home/runner/work/MFC/MFC/src/post_process/m_mpi_proxy.fpp"
332#endif
333
334 end subroutine s_mpi_bcast_user_inputs
335
336 !> Gather spatial extents from all ranks for Silo database metadata
337 impure subroutine s_mpi_gather_spatial_extents(spatial_extents)
338
339 real(wp), dimension(1:,0:), intent(inout) :: spatial_extents
340
341#ifdef MFC_MPI
342 integer :: ierr !< Generic flag used to identify and report MPI errors
343 real(wp) :: ext_temp(0:num_procs - 1)
344
345 ! Simulation is 3D
346
347 if (p > 0) then
348 if (grid_geometry == 3) then
349 ! Minimum spatial extent in the r-direction
350 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
351 & ierr)
352
353 ! Minimum spatial extent in the theta-direction
354 call mpi_gatherv(minval(z_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
355 & ierr)
356
357 ! Minimum spatial extent in the z-direction
358 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
359 & ierr)
360
361 ! Maximum spatial extent in the r-direction
362 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
363 & ierr)
364
365 ! Maximum spatial extent in the theta-direction
366 call mpi_gatherv(maxval(z_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
367 & ierr)
368
369 ! Maximum spatial extent in the z-direction
370 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
371 & ierr)
372 else
373 ! Minimum spatial extent in the x-direction
374 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
375 & ierr)
376
377 ! Minimum spatial extent in the y-direction
378 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
379 & ierr)
380
381 ! Minimum spatial extent in the z-direction
382 call mpi_gatherv(minval(z_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
383 & ierr)
384
385 ! Maximum spatial extent in the x-direction
386 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
387 & ierr)
388
389 ! Maximum spatial extent in the y-direction
390 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
391 & ierr)
392
393 ! Maximum spatial extent in the z-direction
394 call mpi_gatherv(maxval(z_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, mpi_comm_world, &
395 & ierr)
396 end if
397 ! Simulation is 2D
398 else if (n > 0) then
399 ! Minimum spatial extent in the x-direction
400 call mpi_gatherv(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
401
402 ! Minimum spatial extent in the y-direction
403 call mpi_gatherv(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
404
405 ! Maximum spatial extent in the x-direction
406 call mpi_gatherv(maxval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
407
408 ! Maximum spatial extent in the y-direction
409 call mpi_gatherv(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 4*displs, mpi_p, 0, mpi_comm_world, ierr)
410 ! Simulation is 1D
411 else
412 ! For 1D, recvcounts/displs are sized for grid defragmentation (m+1 per rank), not for scalar gathers. Use MPI_GATHER
413 ! instead.
414
415 ! Minimum spatial extent in the x-direction
416 call mpi_gather(minval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
417 if (proc_rank == 0) spatial_extents(1,:) = ext_temp
418
419 ! Maximum spatial extent in the x-direction
420 call mpi_gather(maxval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
421 if (proc_rank == 0) spatial_extents(2,:) = ext_temp
422 end if
423#endif
424
425 end subroutine s_mpi_gather_spatial_extents
426
427 !> Collect the sub-domain cell-boundary or cell-center location data from all processors and put back together the grid of the
428 !! entire computational domain on the rank 0 processor. This is only done for 1D simulations.
429 impure subroutine s_mpi_defragment_1d_grid_variable
430
431#ifdef MFC_MPI
432 integer :: ierr !< Generic flag used to identify and report MPI errors
433 ! Silo-HDF5 database format
434
435 if (format == format_silo) then
436 call mpi_gatherv(x_cc(0), m + 1, mpi_p, x_root_cc(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
437
438 ! Binary database format
439 else
440 call mpi_gatherv(x_cb(0), m + 1, mpi_p, x_root_cb(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
441
442 if (proc_rank == 0) x_root_cb(-1) = x_cb(-1)
443 end if
444#endif
445
446 end subroutine s_mpi_defragment_1d_grid_variable
447
448 !> Gather the Silo database metadata for the flow variable's extents to boost performance of the multidimensional visualization.
449 !! @param q_sf Flow variable on a single computational sub-domain
450 impure subroutine s_mpi_gather_data_extents(q_sf, data_extents)
451
452 real(wp), dimension(:,:,:), intent(in) :: q_sf
453 real(wp), dimension(1:2,0:num_procs - 1), intent(inout) :: data_extents
454
455#ifdef MFC_MPI
456 integer :: ierr !< Generic flag used to identify and report MPI errors
457 real(wp) :: ext_temp(0:num_procs - 1)
458
459 if (n > 0) then
460 ! Multi-D: recvcounts = 1, so strided MPI_GATHERV works correctly Minimum flow variable extent
461 call mpi_gatherv(minval(q_sf), 1, mpi_p, data_extents(1, 0), recvcounts, 2*displs, mpi_p, 0, mpi_comm_world, ierr)
462
463 ! Maximum flow variable extent
464 call mpi_gatherv(maxval(q_sf), 1, mpi_p, data_extents(2, 0), recvcounts, 2*displs, mpi_p, 0, mpi_comm_world, ierr)
465 else
466 ! 1D: recvcounts/displs are sized for grid defragmentation (m+1 per rank), not for scalar gathers. Use MPI_GATHER
467 ! instead.
468
469 ! Minimum flow variable extent
470 call mpi_gather(minval(q_sf), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
471 if (proc_rank == 0) data_extents(1,:) = ext_temp
472
473 ! Maximum flow variable extent
474 call mpi_gather(maxval(q_sf), 1, mpi_p, ext_temp, 1, mpi_p, 0, mpi_comm_world, ierr)
475 if (proc_rank == 0) data_extents(2,:) = ext_temp
476 end if
477#endif
478
479 end subroutine s_mpi_gather_data_extents
480
481 !> Gather the sub-domain flow variable data from all processors and reassemble it for the entire computational domain on the
482 !! rank 0 processor. This is only done for 1D simulations.
483 !! @param q_sf Flow variable on a single computational sub-domain
484 !! @param q_root_sf Flow variable on the entire computational domain
485 impure subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf)
486
487 real(wp), dimension(0:m), intent(in) :: q_sf
488 real(wp), dimension(0:m), intent(inout) :: q_root_sf
489
490#ifdef MFC_MPI
491 integer :: ierr !< Generic flag used to identify and report MPI errors
492 ! Gathering the sub-domain flow variable data from all the processes and putting it back together for the entire
493 ! computational domain on the process with rank 0
494
495 call mpi_gatherv(q_sf(0), m + 1, mpi_p, q_root_sf(0), recvcounts, displs, mpi_p, 0, mpi_comm_world, ierr)
496#endif
497
498 end subroutine s_mpi_defragment_1d_flow_variable
499
500 !> Deallocation procedures for the module
501 impure subroutine s_finalize_mpi_proxy_module
502
503#ifdef MFC_MPI
504 ! Deallocating the receive counts and the displacement vector variables used in variable-gather communication procedures
505 if ((format == format_silo .and. n > 0) .or. n == 0) then
506 deallocate (recvcounts)
507 deallocate (displs)
508 end if
509#endif
510
511 end subroutine s_finalize_mpi_proxy_module
512
513end module m_mpi_proxy
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::format_silo
integer, parameter format_silo
Definition m_constants.fpp.f90:128
m_constants::num_fluids_max
integer, parameter num_fluids_max
Maximum number of fluids in the simulation.
Definition m_constants.fpp.f90:25
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
Definition m_global_parameters.fpp.f90:19
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:53
m_global_parameters::p_glb
integer p_glb
Definition m_global_parameters.fpp.f90:58
m_global_parameters::bc_z
type(int_bounds_info) bc_z
Definition m_global_parameters.fpp.f90:106
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor.
Definition m_global_parameters.fpp.f90:41
m_global_parameters::x_root_cc
real(wp), dimension(:), allocatable x_root_cc
Definition m_global_parameters.fpp.f90:69
m_global_parameters::bc_io
logical bc_io
Definition m_global_parameters.fpp.f90:103
m_global_parameters::y_cb
real(wp), dimension(:), allocatable y_cb
Definition m_global_parameters.fpp.f90:64
m_global_parameters::x_output
type(bounds_info) x_output
Definition m_global_parameters.fpp.f90:127
m_global_parameters::x_root_cb
real(wp), dimension(:), allocatable x_root_cb
Definition m_global_parameters.fpp.f90:64
m_global_parameters::z_cb
real(wp), dimension(:), allocatable z_cb
Definition m_global_parameters.fpp.f90:64
m_global_parameters::z_output
type(bounds_info) z_output
Portion of domain to output for post-processing.
Definition m_global_parameters.fpp.f90:127
m_global_parameters::bc_y
type(int_bounds_info) bc_y
Definition m_global_parameters.fpp.f90:106
m_global_parameters::x_cc
real(wp), dimension(:), allocatable x_cc
Definition m_global_parameters.fpp.f90:69
m_global_parameters::bc_x
type(int_bounds_info) bc_x
Definition m_global_parameters.fpp.f90:106
m_global_parameters::x_cb
real(wp), dimension(:), allocatable x_cb
Definition m_global_parameters.fpp.f90:64
m_global_parameters::num_procs
integer num_procs
Number of processors.
Definition m_global_parameters.fpp.f90:36
m_global_parameters::m_glb
integer m_glb
Definition m_global_parameters.fpp.f90:58
m_global_parameters::n_glb
integer n_glb
Definition m_global_parameters.fpp.f90:58
m_global_parameters::cfl_dt
logical cfl_dt
Definition m_global_parameters.fpp.f90:81
m_global_parameters::y_output
type(bounds_info) y_output
Definition m_global_parameters.fpp.f90:127
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:334
m_mpi_proxy
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
Definition m_mpi_proxy.fpp.f90:7
m_mpi_proxy::s_initialize_mpi_proxy_module
impure subroutine s_initialize_mpi_proxy_module
Computation of parameters, allocation procedures, and/or any other tasks needed to properly setup the...
Definition m_mpi_proxy.fpp.f90:32
m_mpi_proxy::recvcounts
integer, dimension(:), allocatable recvcounts
Definition m_mpi_proxy.fpp.f90:24
m_mpi_proxy::s_mpi_defragment_1d_grid_variable
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...
Definition m_mpi_proxy.fpp.f90:430
m_mpi_proxy::s_mpi_defragment_1d_flow_variable
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...
Definition m_mpi_proxy.fpp.f90:486
m_mpi_proxy::s_mpi_gather_spatial_extents
impure subroutine s_mpi_gather_spatial_extents(spatial_extents)
Gather spatial extents from all ranks for Silo database metadata.
Definition m_mpi_proxy.fpp.f90:338
m_mpi_proxy::s_mpi_bcast_user_inputs
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...
Definition m_mpi_proxy.fpp.f90:65
m_mpi_proxy::s_mpi_gather_data_extents
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...
Definition m_mpi_proxy.fpp.f90:451
m_mpi_proxy::s_finalize_mpi_proxy_module
impure subroutine s_finalize_mpi_proxy_module
Deallocation procedures for the module.
Definition m_mpi_proxy.fpp.f90:502
m_mpi_proxy::displs
integer, dimension(:), allocatable displs
Definition m_mpi_proxy.fpp.f90:25