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