MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_body_forces.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2!>
3!! @file
4!! @brief Contains module m_body_forces
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp" 2
354
355!> @brief Computes gravitational and body force source terms for the momentum equations
356module m_body_forces
357
358 use m_derived_types
359 use m_global_parameters
360 use m_variables_conversion
361 use m_mpi_proxy
362 use m_helper, only: s_prng_splitmix32, f_unit_vector, f_cross
363 use m_nvtx
364
365 implicit none
366
367 private
368 public :: s_compute_body_forces_rhs, s_compute_synthetic_forces_rhs, s_initialize_body_forces_module, &
369 & s_finalize_body_forces_module
370
371 integer, parameter :: spbf_num_freq = 8
372 real(wp) :: spbf_amp
373 real(wp) :: spbf_xc
374 real(wp) :: spbf_yc
375 real(wp) :: spbf_conv_vel
376 real(wp) :: spbf_sigma
377 real(wp), allocatable, dimension(:) :: freq, phase
378 real(wp), allocatable, dimension(:,:,:) :: rhom
379
380# 31 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
381#if defined(MFC_OpenACC)
382# 31 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
383!$acc declare create(spbf_amp, spbf_xc, spbf_yc, spbf_conv_vel, spbf_sigma, freq, phase, rhoM)
384# 31 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
385#elif defined(MFC_OpenMP)
386# 31 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
387!$omp declare target (spbf_amp, spbf_xc, spbf_yc, spbf_conv_vel, spbf_sigma, freq, phase, rhoM)
388# 31 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
389#endif
390# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
391
392 integer :: num_synthetic_wave_numbers
393
394# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
395#if defined(MFC_OpenACC)
396# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
397!$acc declare create(num_synthetic_wave_numbers)
398# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
399#elif defined(MFC_OpenMP)
400# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
401!$omp declare target (num_synthetic_wave_numbers)
402# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
403#endif
404# 35 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
405
406 real(wp), allocatable, dimension(:) :: synthetic_k_x, synthetic_k_y, synthetic_k_z
407 real(wp), allocatable, dimension(:) :: synthetic_phase, synthetic_amp
408 ! Solenoidal (divergence-free) unit vector per mode: perpendicular to k in the plane of excitation.
409 ! 1-D: ex = 1, ey = 0 (streamwise only)
410 ! 2-D: ex = -k_y/|k|, ey = k_x/|k| (perpendicular to k on the circle)
411 ! 3-D: stored from random frame built at init
412 real(wp), allocatable, dimension(:) :: synthetic_ex, synthetic_ey, synthetic_ez
413
414# 43 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
415#if defined(MFC_OpenACC)
416# 43 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
417!$acc declare create(synthetic_k_x, synthetic_k_y, synthetic_k_z, synthetic_phase, synthetic_amp)
418# 43 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
419#elif defined(MFC_OpenMP)
420# 43 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
421!$omp declare target (synthetic_k_x, synthetic_k_y, synthetic_k_z, synthetic_phase, synthetic_amp)
422# 43 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
423#endif
424# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
425
426# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
427#if defined(MFC_OpenACC)
428# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
429!$acc declare create(synthetic_ex, synthetic_ey, synthetic_ez)
430# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
431#elif defined(MFC_OpenMP)
432# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
433!$omp declare target (synthetic_ex, synthetic_ey, synthetic_ez)
434# 44 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
435#endif
436# 45 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
437
438contains
439
440 !> Initialize the body forces module. When synthetic_turbulence is enabled,
441 !> generates random wave vectors for each energy shell on rank 0, then
442 !> broadcasts to all MPI ranks and copies to GPU.
443 impure subroutine s_initialize_body_forces_module
444
445 integer :: s, m_wave, m_global
446 integer(kind=selected_int_kind(18)) :: seed
447 real(wp) :: rn1, rn2, k_mag
448 real(wp), dimension(3) :: khat, xi, sig, sig_tmp
449
450 if (n > 0) then
451 if (p > 0) then
452#ifdef MFC_DEBUG
453# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
454 block
455# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
456 use iso_fortran_env, only: output_unit
457# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
458
459# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
460 print *, 'm_body_forces.fpp:60: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))'
461# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
462
463# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
464 call flush (output_unit)
465# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
466 end block
467# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
468#endif
469# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
470 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
471# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
472
473# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
474
475# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
476#if defined(MFC_OpenACC)
477# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
478!$acc enter data create(rhoM)
479# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
480#elif defined(MFC_OpenMP)
481# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
482!$omp target enter data map(always,alloc:rhoM)
483# 60 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
484#endif
485# 61 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
486 else
487#ifdef MFC_DEBUG
488# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
489 block
490# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
491 use iso_fortran_env, only: output_unit
492# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
493
494# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
495 print *, 'm_body_forces.fpp:62: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))'
496# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
497
498# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
499 call flush (output_unit)
500# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
501 end block
502# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
503#endif
504# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
505 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
506# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
507
508# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
509
510# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
511#if defined(MFC_OpenACC)
512# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
513!$acc enter data create(rhoM)
514# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
515#elif defined(MFC_OpenMP)
516# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
517!$omp target enter data map(always,alloc:rhoM)
518# 62 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
519#endif
520# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
521 end if
522 else
523#ifdef MFC_DEBUG
524# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
525 block
526# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
527 use iso_fortran_env, only: output_unit
528# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
529
530# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
531 print *, 'm_body_forces.fpp:65: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, 0:0, 0:0))'
532# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
533
534# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
535 call flush (output_unit)
536# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
537 end block
538# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
539#endif
540# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
541 allocate (rhom(-buff_size:buff_size + m, 0:0, 0:0))
542# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
543
544# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
545
546# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
547#if defined(MFC_OpenACC)
548# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
549!$acc enter data create(rhoM)
550# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
551#elif defined(MFC_OpenMP)
552# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
553!$omp target enter data map(always,alloc:rhoM)
554# 65 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
555#endif
556# 66 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
557 end if
558
559 if (bf_spatial_support) then
560 call s_initialize_body_force_with_spatial_support
561 end if
562
563 if (.not. synthetic_turbulence) return
564 if (synth_n_shells <= 0) return
565
566 num_synthetic_wave_numbers = sum(synth_n_waves_per_shell(1:synth_n_shells))
567
568 if (num_synthetic_wave_numbers == 0) return
569
570#ifdef MFC_DEBUG
571# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
572 block
573# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
574 use iso_fortran_env, only: output_unit
575# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
576
577# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
578 print *, 'm_body_forces.fpp:79: ', '@:ALLOCATE(synthetic_k_x(1:num_synthetic_wave_numbers))'
579# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
580
581# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
582 call flush (output_unit)
583# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
584 end block
585# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
586#endif
587# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
588 allocate (synthetic_k_x(1:num_synthetic_wave_numbers))
589# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
590
591# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
592
593# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
594#if defined(MFC_OpenACC)
595# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
596!$acc enter data create(synthetic_k_x)
597# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
598#elif defined(MFC_OpenMP)
599# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
600!$omp target enter data map(always,alloc:synthetic_k_x)
601# 79 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
602#endif
603# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
604#ifdef MFC_DEBUG
605# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
606 block
607# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
608 use iso_fortran_env, only: output_unit
609# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
610
611# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
612 print *, 'm_body_forces.fpp:80: ', '@:ALLOCATE(synthetic_phase(1:num_synthetic_wave_numbers))'
613# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
614
615# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
616 call flush (output_unit)
617# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
618 end block
619# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
620#endif
621# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
622 allocate (synthetic_phase(1:num_synthetic_wave_numbers))
623# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
624
625# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
626
627# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
628#if defined(MFC_OpenACC)
629# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
630!$acc enter data create(synthetic_phase)
631# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
632#elif defined(MFC_OpenMP)
633# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
634!$omp target enter data map(always,alloc:synthetic_phase)
635# 80 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
636#endif
637# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
638#ifdef MFC_DEBUG
639# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
640 block
641# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
642 use iso_fortran_env, only: output_unit
643# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
644
645# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
646 print *, 'm_body_forces.fpp:81: ', '@:ALLOCATE(synthetic_amp(1:num_synthetic_wave_numbers))'
647# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
648
649# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
650 call flush (output_unit)
651# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
652 end block
653# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
654#endif
655# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
656 allocate (synthetic_amp(1:num_synthetic_wave_numbers))
657# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
658
659# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
660
661# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
662#if defined(MFC_OpenACC)
663# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
664!$acc enter data create(synthetic_amp)
665# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
666#elif defined(MFC_OpenMP)
667# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
668!$omp target enter data map(always,alloc:synthetic_amp)
669# 81 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
670#endif
671# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
672#ifdef MFC_DEBUG
673# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
674 block
675# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
676 use iso_fortran_env, only: output_unit
677# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
678
679# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
680 print *, 'm_body_forces.fpp:82: ', '@:ALLOCATE(synthetic_ex(1:num_synthetic_wave_numbers))'
681# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
682
683# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
684 call flush (output_unit)
685# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
686 end block
687# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
688#endif
689# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
690 allocate (synthetic_ex(1:num_synthetic_wave_numbers))
691# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
692
693# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
694
695# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
696#if defined(MFC_OpenACC)
697# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
698!$acc enter data create(synthetic_ex)
699# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
700#elif defined(MFC_OpenMP)
701# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
702!$omp target enter data map(always,alloc:synthetic_ex)
703# 82 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
704#endif
705# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
706#ifdef MFC_DEBUG
707# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
708 block
709# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
710 use iso_fortran_env, only: output_unit
711# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
712
713# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
714 print *, 'm_body_forces.fpp:83: ', '@:ALLOCATE(synthetic_ey(1:num_synthetic_wave_numbers))'
715# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
716
717# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
718 call flush (output_unit)
719# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
720 end block
721# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
722#endif
723# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
724 allocate (synthetic_ey(1:num_synthetic_wave_numbers))
725# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
726
727# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
728
729# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
730#if defined(MFC_OpenACC)
731# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
732!$acc enter data create(synthetic_ey)
733# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
734#elif defined(MFC_OpenMP)
735# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
736!$omp target enter data map(always,alloc:synthetic_ey)
737# 83 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
738#endif
739# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
740#ifdef MFC_DEBUG
741# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
742 block
743# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
744 use iso_fortran_env, only: output_unit
745# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
746
747# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
748 print *, 'm_body_forces.fpp:84: ', '@:ALLOCATE(synthetic_ez(1:num_synthetic_wave_numbers))'
749# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
750
751# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
752 call flush (output_unit)
753# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
754 end block
755# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
756#endif
757# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
758 allocate (synthetic_ez(1:num_synthetic_wave_numbers))
759# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
760
761# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
762
763# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
764#if defined(MFC_OpenACC)
765# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
766!$acc enter data create(synthetic_ez)
767# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
768#elif defined(MFC_OpenMP)
769# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
770!$omp target enter data map(always,alloc:synthetic_ez)
771# 84 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
772#endif
773# 85 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
774
775 if (num_dims > 1) then
776#ifdef MFC_DEBUG
777# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
778 block
779# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
780 use iso_fortran_env, only: output_unit
781# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
782
783# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
784 print *, 'm_body_forces.fpp:87: ', '@:ALLOCATE(synthetic_k_y(1:num_synthetic_wave_numbers))'
785# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
786
787# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
788 call flush (output_unit)
789# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
790 end block
791# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
792#endif
793# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
794 allocate (synthetic_k_y(1:num_synthetic_wave_numbers))
795# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
796
797# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
798
799# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
800#if defined(MFC_OpenACC)
801# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
802!$acc enter data create(synthetic_k_y)
803# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
804#elif defined(MFC_OpenMP)
805# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
806!$omp target enter data map(always,alloc:synthetic_k_y)
807# 87 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
808#endif
809# 88 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
810 end if
811
812 if (num_dims == 3) then
813#ifdef MFC_DEBUG
814# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
815 block
816# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
817 use iso_fortran_env, only: output_unit
818# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
819
820# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
821 print *, 'm_body_forces.fpp:91: ', '@:ALLOCATE(synthetic_k_z(1:num_synthetic_wave_numbers))'
822# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
823
824# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
825 call flush (output_unit)
826# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
827 end block
828# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
829#endif
830# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
831 allocate (synthetic_k_z(1:num_synthetic_wave_numbers))
832# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
833
834# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
835
836# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
837#if defined(MFC_OpenACC)
838# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
839!$acc enter data create(synthetic_k_z)
840# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
841#elif defined(MFC_OpenMP)
842# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
843!$omp target enter data map(always,alloc:synthetic_k_z)
844# 91 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
845#endif
846# 92 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
847 end if
848
849 ! Generate random wave vectors and phases on rank 0, then broadcast. Uses the
850 ! compiler-independent integer generator s_prng_splitmix32 so the forcing is
851 ! reproducible across compilers; the 3-D polarization is built perpendicular
852 ! to k via a double cross product, guaranteeing a divergence-free (solenoidal) mode.
853 if (proc_rank == 0) then
854 seed = int(synth_seed, kind(seed))
855
856 m_global = 0
857 do s = 1, synth_n_shells
858 k_mag = synth_k_shell(s)
859 do m_wave = 1, synth_n_waves_per_shell(s)
860 m_global = m_global + 1
861
862 if (num_dims == 1) then
863 synthetic_k_x(m_global) = k_mag
864 ! Streamwise forcing only in 1-D
865 synthetic_ex(m_global) = 1._wp
866 synthetic_ey(m_global) = 0._wp
867 synthetic_ez(m_global) = 0._wp
868 else if (num_dims == 2) then
869 ! In-plane wavevector at azimuth theta; solenoidal dir perpendicular to k
870 call s_prng_splitmix32(rn1, seed)
871 rn1 = rn1*2._wp*pi
872 synthetic_k_x(m_global) = k_mag*cos(rn1)
873 synthetic_k_y(m_global) = k_mag*sin(rn1)
874 synthetic_ex(m_global) = -sin(rn1)
875 synthetic_ey(m_global) = cos(rn1)
876 synthetic_ez(m_global) = 0._wp
877 else
878 ! Random unit wavevector uniform on the sphere
879 call s_prng_splitmix32(rn1, seed)
880 call s_prng_splitmix32(rn2, seed)
881 khat = f_unit_vector(rn1, rn2)
882 ! Random reference vector projected perpendicular to k by a double
883 ! cross product: sig = khat x (xi x khat) is a unit vector with k.sig = 0
884 call s_prng_splitmix32(rn1, seed)
885 call s_prng_splitmix32(rn2, seed)
886 xi = f_unit_vector(rn1, rn2)
887 sig_tmp = f_cross(xi, khat)
888 sig_tmp = sig_tmp/max(sqrt(sum(sig_tmp**2._wp)), 1.e-10_wp)
889 sig = f_cross(khat, sig_tmp)
890 synthetic_k_x(m_global) = k_mag*khat(1)
891 synthetic_k_y(m_global) = k_mag*khat(2)
892 synthetic_k_z(m_global) = k_mag*khat(3)
893 synthetic_ex(m_global) = sig(1)
894 synthetic_ey(m_global) = sig(2)
895 synthetic_ez(m_global) = sig(3)
896 end if
897
898 call s_prng_splitmix32(rn1, seed)
899 synthetic_phase(m_global) = rn1*2._wp*pi
900
901 synthetic_amp(m_global) = synth_amp_shell(s)
902 end do
903 end do
904 end if
905
906 ! Broadcast from rank 0 to all ranks
907 call s_mpi_send_random_number(synthetic_k_x, num_synthetic_wave_numbers)
908 call s_mpi_send_random_number(synthetic_phase, num_synthetic_wave_numbers)
909 call s_mpi_send_random_number(synthetic_amp, num_synthetic_wave_numbers)
910 call s_mpi_send_random_number(synthetic_ex, num_synthetic_wave_numbers)
911 call s_mpi_send_random_number(synthetic_ey, num_synthetic_wave_numbers)
912 call s_mpi_send_random_number(synthetic_ez, num_synthetic_wave_numbers)
913
914 if (num_dims > 1) then
915 call s_mpi_send_random_number(synthetic_k_y, num_synthetic_wave_numbers)
916 end if
917
918 if (num_dims == 3) then
919 call s_mpi_send_random_number(synthetic_k_z, num_synthetic_wave_numbers)
920 end if
921
922 ! Push wave data to GPU
923
924# 168 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
925#if defined(MFC_OpenACC)
926# 168 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
927!$acc update device(num_synthetic_wave_numbers, synthetic_k_x, synthetic_phase, synthetic_amp)
928# 168 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
929#elif defined(MFC_OpenMP)
930# 168 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
931!$omp target update to(num_synthetic_wave_numbers, synthetic_k_x, synthetic_phase, synthetic_amp)
932# 168 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
933#endif
934# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
935
936# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
937#if defined(MFC_OpenACC)
938# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
939!$acc update device(synthetic_ex, synthetic_ey, synthetic_ez)
940# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
941#elif defined(MFC_OpenMP)
942# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
943!$omp target update to(synthetic_ex, synthetic_ey, synthetic_ez)
944# 169 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
945#endif
946# 170 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
947
948 if (num_dims > 1) then
949
950# 172 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
951#if defined(MFC_OpenACC)
952# 172 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
953!$acc update device(synthetic_k_y)
954# 172 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
955#elif defined(MFC_OpenMP)
956# 172 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
957!$omp target update to(synthetic_k_y)
958# 172 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
959#endif
960# 173 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
961 end if
962
963 if (num_dims == 3) then
964
965# 176 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
966#if defined(MFC_OpenACC)
967# 176 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
968!$acc update device(synthetic_k_z)
969# 176 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
970#elif defined(MFC_OpenMP)
971# 176 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
972!$omp target update to(synthetic_k_z)
973# 176 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
974#endif
975# 177 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
976 end if
977
978 end subroutine s_initialize_body_forces_module
979
980 !> Initialize a body force with spatial support presented in Wei & Freund (JFM, 2005)
981 impure subroutine s_initialize_body_force_with_spatial_support
982
983 integer :: f !< frequency iterator
984
985 spbf_amp = spatial_bf%amp
986 spbf_xc = spatial_bf%x_centroid
987 spbf_yc = spatial_bf%y_centroid
988 spbf_conv_vel = spatial_bf%conv_vel
989 spbf_sigma = spatial_bf%sigma
990
991#ifdef MFC_DEBUG
992# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
993 block
994# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
995 use iso_fortran_env, only: output_unit
996# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
997
998# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
999 print *, 'm_body_forces.fpp:192: ', '@:ALLOCATE(freq(spbf_num_freq), phase(spbf_num_freq))'
1000# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1001
1002# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1003 call flush (output_unit)
1004# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1005 end block
1006# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1007#endif
1008# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1009 allocate (freq(spbf_num_freq), phase(spbf_num_freq))
1010# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1011
1012# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1013
1014# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1015
1016# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1017#if defined(MFC_OpenACC)
1018# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1019!$acc enter data create(freq, phase)
1020# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1021#elif defined(MFC_OpenMP)
1022# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1023!$omp target enter data map(always,alloc:freq, phase)
1024# 192 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1025#endif
1026# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1027#ifdef __NVCOMPILER_GPU_UNIFIED_MEM
1028# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1029 block
1030# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1031 ! NVIDIA CUDA Fortran 25.3+: uses submodules (cuda_runtime_api, gpu_reductions, sort) See
1032# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1033 ! https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#fortran-host-modules
1034# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1035#if __NVCOMPILER_MAJOR__ < 25 || (__NVCOMPILER_MAJOR__ == 25 && __NVCOMPILER_MINOR__ < 3)
1036# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1037 use cudafor, gpu_sum => sum, gpu_maxval => maxval, gpu_minval => minval
1038# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1039#else
1040# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1041 use cuda_runtime_api
1042# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1043#endif
1044# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1045 integer :: istat
1046# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1047
1048# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1049 if (nv_uvm_pref_gpu) then
1050# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1051 ! set preferred location GPU
1052# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1053 istat = cudamemadvise(c_devloc(freq), sizeof(freq), cudamemadvisesetpreferredlocation, 0)
1054# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1055 if (istat /= cudasuccess) then
1056# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1057 write (*, "('Error code: ',I0, ': ')") istat
1058# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1059 end if
1060# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1061 ! set accessed by CPU
1062# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1063 istat = cudamemadvise(c_devloc(freq), sizeof(freq), cudamemadvisesetaccessedby, cudacpudeviceid)
1064# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1065 if (istat /= cudasuccess) then
1066# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1067 write (*, "('Error code: ',I0, ': ')") istat
1068# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1069 end if
1070# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1071 ! prefetch to GPU - physically populate memory pages
1072# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1073 istat = cudamemprefetchasync(c_devloc(freq), sizeof(freq), 0, 0)
1074# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1075 if (istat /= cudasuccess) then
1076# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1077 write (*, "('Error code: ',I0, ': ')") istat
1078# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1079 end if
1080# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1081 end if
1082# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1083 end block
1084# 193 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1085#endif
1086# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1087#ifdef __NVCOMPILER_GPU_UNIFIED_MEM
1088# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1089 block
1090# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1091 ! NVIDIA CUDA Fortran 25.3+: uses submodules (cuda_runtime_api, gpu_reductions, sort) See
1092# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1093 ! https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#fortran-host-modules
1094# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1095#if __NVCOMPILER_MAJOR__ < 25 || (__NVCOMPILER_MAJOR__ == 25 && __NVCOMPILER_MINOR__ < 3)
1096# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1097 use cudafor, gpu_sum => sum, gpu_maxval => maxval, gpu_minval => minval
1098# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1099#else
1100# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1101 use cuda_runtime_api
1102# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1103#endif
1104# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1105 integer :: istat
1106# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1107
1108# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1109 if (nv_uvm_pref_gpu) then
1110# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1111 ! set preferred location GPU
1112# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1113 istat = cudamemadvise(c_devloc(phase), sizeof(phase), cudamemadvisesetpreferredlocation, 0)
1114# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1115 if (istat /= cudasuccess) then
1116# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1117 write (*, "('Error code: ',I0, ': ')") istat
1118# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1119 end if
1120# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1121 ! set accessed by CPU
1122# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1123 istat = cudamemadvise(c_devloc(phase), sizeof(phase), cudamemadvisesetaccessedby, cudacpudeviceid)
1124# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1125 if (istat /= cudasuccess) then
1126# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1127 write (*, "('Error code: ',I0, ': ')") istat
1128# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1129 end if
1130# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1131 ! prefetch to GPU - physically populate memory pages
1132# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1133 istat = cudamemprefetchasync(c_devloc(phase), sizeof(phase), 0, 0)
1134# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1135 if (istat /= cudasuccess) then
1136# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1137 write (*, "('Error code: ',I0, ': ')") istat
1138# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1139 end if
1140# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1141 end if
1142# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1143 end block
1144# 194 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1145#endif
1146# 195 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1147 do f = 1, spbf_num_freq
1148 freq(f) = spatial_bf%freq(f)
1149 phase(f) = spatial_bf%phase(f)
1150 end do
1151
1152# 199 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1153#if defined(MFC_OpenACC)
1154# 199 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1155!$acc update device(spbf_amp, spbf_xc, spbf_yc, spbf_conv_vel, spbf_sigma, freq, phase)
1156# 199 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1157#elif defined(MFC_OpenMP)
1158# 199 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1159!$omp target update to(spbf_amp, spbf_xc, spbf_yc, spbf_conv_vel, spbf_sigma, freq, phase)
1160# 199 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1161#endif
1162# 200 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1163
1164 end subroutine s_initialize_body_force_with_spatial_support
1165
1166 !> Compute the acceleration at time t
1167 subroutine s_compute_acceleration(t)
1168
1169 real(wp), intent(in) :: t
1170
1171# 209 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1172 if (bf_x) then
1173# 210 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1174 accel_bf(1) = g_x + k_x*sin(w_x*t - p_x)
1175# 211 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1176 end if
1177# 209 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1178 if (bf_y) then
1179# 210 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1180 accel_bf(2) = g_y + k_y*sin(w_y*t - p_y)
1181# 211 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1182 end if
1183# 209 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1184 if (bf_z) then
1185# 210 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1186 accel_bf(3) = g_z + k_z*sin(w_z*t - p_z)
1187# 211 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1188 end if
1189# 213 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1190
1191
1192# 214 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1193#if defined(MFC_OpenACC)
1194# 214 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1195!$acc update device(accel_bf)
1196# 214 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1197#elif defined(MFC_OpenMP)
1198# 214 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1199!$omp target update to(accel_bf)
1200# 214 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1201#endif
1202# 215 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1203
1204 end subroutine s_compute_acceleration
1205
1206 !> Apply the body force of Wei & Freund (JFM, 2005)
1207 subroutine s_compute_body_force_with_spatial_support(t, bounds)
1208
1209 real(wp), intent(in) :: t
1210 type(int_bounds_info), dimension(1:3), intent(in) :: bounds
1211 real(wp) :: support !< spatial support
1212 real(wp) :: theta_x, theta_y, pre_fac !< auxiliary variables
1213 integer :: f !< frequency iterator
1214 integer :: j, k, l !< standard iterators
1215
1216 ! Safety check: if convective velocity is too small, skip computation
1217
1218 if (abs(spbf_conv_vel) < 1.0e-12_wp) then
1219
1220# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1221
1222# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1223#if defined(MFC_OpenACC)
1224# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1225!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1226# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1227#elif defined(MFC_OpenMP)
1228# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1229
1230# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1231
1232# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1233
1234# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1235!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1236# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1237!$omp& map(to:bounds)
1238# 231 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1239#endif
1240# 232 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1241 do l = bounds(3)%beg, bounds(3)%end
1242 do k = bounds(2)%beg, bounds(2)%end
1243 do j = bounds(1)%beg, bounds(1)%end
1244 spbf_source_x(j, k, l) = 0._wp
1245 spbf_source_y(j, k, l) = 0._wp
1246 end do
1247 end do
1248 end do
1249
1250# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1251#if defined(MFC_OpenACC)
1252# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1253!$acc end parallel loop
1254# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1255#elif defined(MFC_OpenMP)
1256# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1257
1258# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1259!$omp end target teams loop
1260# 240 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1261#endif
1262# 241 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1263 return
1264 end if
1265
1266
1267# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1268
1269# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1270#if defined(MFC_OpenACC)
1271# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1272!$acc parallel loop collapse(3) gang vector default(present) private(support, theta_x, theta_y, pre_fac, f, j, k, l) copyin(bounds, t)
1273# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1274#elif defined(MFC_OpenMP)
1275# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1276
1277# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1278
1279# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1280
1281# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1282!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1283# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1284!$omp& private(support, theta_x, theta_y, pre_fac, f, j, k, l) map(to:bounds, t)
1285# 244 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1286#endif
1287# 245 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1288 do l = bounds(3)%beg, bounds(3)%end
1289 do k = bounds(2)%beg, bounds(2)%end
1290 do j = bounds(1)%beg, bounds(1)%end
1291 support = exp(-spbf_sigma*((x_cc(j) - spbf_xc)**2 + (y_cc(k) - spbf_yc)**2))
1292 spbf_source_x(j, k, l) = 0._wp
1293 spbf_source_y(j, k, l) = 0._wp
1294 do f = 1, spbf_num_freq
1295 pre_fac = (freq(f)/spbf_conv_vel)
1296 theta_x = pre_fac*(x_cc(j) - spbf_xc - spbf_conv_vel*t) + phase(f)
1297 theta_y = pre_fac*(y_cc(k) - spbf_yc) + phase(f)
1298 spbf_source_x(j, k, l) = spbf_source_x(j, k, &
1299 & l) + spbf_amp*support*(pre_fac*sin(theta_x)*cos(theta_y) - 2._wp*spbf_sigma*(y_cc(k) &
1300 & - spbf_yc)*sin(theta_x)*sin(theta_y))
1301 spbf_source_y(j, k, l) = spbf_source_y(j, k, &
1302 & l) - spbf_amp*support*(pre_fac*cos(theta_x)*sin(theta_y) - 2._wp*spbf_sigma*(x_cc(j) &
1303 & - spbf_xc)*sin(theta_x)*sin(theta_y))
1304 end do
1305 end do
1306 end do
1307 end do
1308
1309# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1310#if defined(MFC_OpenACC)
1311# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1312!$acc end parallel loop
1313# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1314#elif defined(MFC_OpenMP)
1315# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1316
1317# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1318!$omp end target teams loop
1319# 265 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1320#endif
1321# 266 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1322
1323 end subroutine s_compute_body_force_with_spatial_support
1324
1325 !> Compute the mixture density at each cell center
1326 subroutine s_compute_mixture_density(q_cons_vf, bounds)
1327
1328 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
1329 type(int_bounds_info), dimension(1:3), intent(in) :: bounds
1330 integer :: i, j, k, l !< standard iterators
1331
1332
1333# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1334
1335# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1336#if defined(MFC_OpenACC)
1337# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1338!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1339# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1340#elif defined(MFC_OpenMP)
1341# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1342
1343# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1344
1345# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1346
1347# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1348!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1349# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1350!$omp& map(to:bounds)
1351# 276 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1352#endif
1353# 277 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1354 do l = bounds(3)%beg, bounds(3)%end
1355 do k = bounds(2)%beg, bounds(2)%end
1356 do j = bounds(1)%beg, bounds(1)%end
1357 rhom(j, k, l) = 0._wp
1358 do i = 1, num_fluids
1359 rhom(j, k, l) = rhom(j, k, l) + q_cons_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l)
1360 end do
1361 end do
1362 end do
1363 end do
1364
1365# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1366#if defined(MFC_OpenACC)
1367# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1368!$acc end parallel loop
1369# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1370#elif defined(MFC_OpenMP)
1371# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1372
1373# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1374!$omp end target teams loop
1375# 287 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1376#endif
1377# 288 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1378
1379 end subroutine s_compute_mixture_density
1380
1381 !> Compute the body force source terms for momentum and energy equations
1382 subroutine s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf, bounds)
1383
1384 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1385 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
1386 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
1387 type(int_bounds_info), dimension(1:3), intent(in) :: bounds
1388 integer :: i, j, k, l !< Loop variables
1389
1390 if (bf_x .or. bf_y .or. bf_z) then
1391 call s_compute_acceleration(mytime)
1392 end if
1393
1394 if (bf_spatial_support) then
1395 call s_compute_body_force_with_spatial_support(mytime, bounds)
1396 end if
1397
1398 call s_compute_mixture_density(q_cons_vf, bounds)
1399
1400
1401# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1402
1403# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1404#if defined(MFC_OpenACC)
1405# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1406!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l) copyin(bounds)
1407# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1408#elif defined(MFC_OpenMP)
1409# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1410
1411# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1412
1413# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1414
1415# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1416!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l) &
1417# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1418!$omp& map(to:bounds)
1419# 310 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1420#endif
1421# 311 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1422 do i = eqn_idx%mom%beg, eqn_idx%E
1423 do l = bounds(3)%beg, bounds(3)%end
1424 do k = bounds(2)%beg, bounds(2)%end
1425 do j = bounds(1)%beg, bounds(1)%end
1426 rhs_vf(i)%sf(j, k, l) = 0._wp
1427 end do
1428 end do
1429 end do
1430 end do
1431
1432# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1433#if defined(MFC_OpenACC)
1434# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1435!$acc end parallel loop
1436# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1437#elif defined(MFC_OpenMP)
1438# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1439
1440# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1441!$omp end target teams loop
1442# 320 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1443#endif
1444# 321 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1445
1446 if (bf_spatial_support) then
1447
1448# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1449
1450# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1451#if defined(MFC_OpenACC)
1452# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1453!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1454# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1455#elif defined(MFC_OpenMP)
1456# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1457
1458# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1459
1460# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1461
1462# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1463!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1464# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1465!$omp& map(to:bounds)
1466# 323 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1467#endif
1468# 324 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1469 do l = bounds(3)%beg, bounds(3)%end
1470 do k = bounds(2)%beg, bounds(2)%end
1471 do j = bounds(1)%beg, bounds(1)%end
1472 rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) + spbf_source_x(j, k, l)
1473 rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) + spbf_source_y(j, k, l)
1474 ! Energy work term u*f: velocity (mom/rho) dotted with the momentum source,
1475 ! matching the bf_x/y/z convention below so the forcing is energy-consistent.
1476 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + (q_cons_vf(eqn_idx%mom%beg)%sf(j, k, &
1477 & l)/rhom(j, k, l))*spbf_source_x(j, k, l) + (q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/rhom(j, &
1478 & k, l))*spbf_source_y(j, k, l)
1479 end do
1480 end do
1481 end do
1482
1483# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1484#if defined(MFC_OpenACC)
1485# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1486!$acc end parallel loop
1487# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1488#elif defined(MFC_OpenMP)
1489# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1490
1491# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1492!$omp end target teams loop
1493# 337 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1494#endif
1495# 338 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1496 end if
1497
1498 if (bf_x) then ! x-direction body forces
1499
1500# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1501
1502# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1503#if defined(MFC_OpenACC)
1504# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1505!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1506# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1507#elif defined(MFC_OpenMP)
1508# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1509
1510# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1511
1512# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1513
1514# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1515!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1516# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1517!$omp& map(to:bounds)
1518# 341 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1519#endif
1520# 342 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1521 do l = bounds(3)%beg, bounds(3)%end
1522 do k = bounds(2)%beg, bounds(2)%end
1523 do j = bounds(1)%beg, bounds(1)%end
1524 rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) + rhom(j, k, l)*accel_bf(1)
1525 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%beg)%sf(j, k, &
1526 & l)*accel_bf(1)
1527 end do
1528 end do
1529 end do
1530
1531# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1532#if defined(MFC_OpenACC)
1533# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1534!$acc end parallel loop
1535# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1536#elif defined(MFC_OpenMP)
1537# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1538
1539# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1540!$omp end target teams loop
1541# 351 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1542#endif
1543# 352 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1544 end if
1545
1546 if (bf_y) then ! y-direction body forces
1547
1548# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1549
1550# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1551#if defined(MFC_OpenACC)
1552# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1553!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1554# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1555#elif defined(MFC_OpenMP)
1556# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1557
1558# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1559
1560# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1561
1562# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1563!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1564# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1565!$omp& map(to:bounds)
1566# 355 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1567#endif
1568# 356 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1569 do l = bounds(3)%beg, bounds(3)%end
1570 do k = bounds(2)%beg, bounds(2)%end
1571 do j = bounds(1)%beg, bounds(1)%end
1572 rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) + rhom(j, k, &
1573 & l)*accel_bf(2)
1574 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
1575 & l)*accel_bf(2)
1576 end do
1577 end do
1578 end do
1579
1580# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1581#if defined(MFC_OpenACC)
1582# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1583!$acc end parallel loop
1584# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1585#elif defined(MFC_OpenMP)
1586# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1587
1588# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1589!$omp end target teams loop
1590# 366 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1591#endif
1592# 367 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1593 end if
1594
1595 if (bf_z) then ! z-direction body forces
1596
1597# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1598
1599# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1600#if defined(MFC_OpenACC)
1601# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1602!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l) copyin(bounds)
1603# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1604#elif defined(MFC_OpenMP)
1605# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1606
1607# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1608
1609# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1610
1611# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1612!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l) &
1613# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1614!$omp& map(to:bounds)
1615# 370 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1616#endif
1617# 371 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1618 do l = bounds(3)%beg, bounds(3)%end
1619 do k = bounds(2)%beg, bounds(2)%end
1620 do j = bounds(1)%beg, bounds(1)%end
1621 rhs_vf(eqn_idx%mom%end)%sf(j, k, l) = rhs_vf(eqn_idx%mom%end)%sf(j, k, l) + rhom(j, k, l)*accel_bf(3)
1622 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%end)%sf(j, k, &
1623 & l)*accel_bf(3)
1624 end do
1625 end do
1626 end do
1627
1628# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1629#if defined(MFC_OpenACC)
1630# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1631!$acc end parallel loop
1632# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1633#elif defined(MFC_OpenMP)
1634# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1635
1636# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1637!$omp end target teams loop
1638# 380 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1639#endif
1640# 381 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1641 end if
1642
1643 end subroutine s_compute_body_forces_rhs
1644
1645 !> Compute the synthetic turbulence RHS contribution.
1646 !>
1647 !> Each Fourier mode m has wave vector k_m and a pre-computed solenoidal
1648 !> (divergence-free) direction e_m perpendicular to k_m. The force field
1649 !> is F = rho * (sum_m A_m * cos(k_m.(x-U*t*xhat) + phi_m) * e_m) * (U/Lx) * G.
1650 !> This excites all velocity components correctly and is zero outside the
1651 !> bounding box of the Gaussian window.
1652 subroutine s_compute_synthetic_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf)
1653
1654 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1655 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
1656 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
1657 integer :: i, j, k, l, n_mode, turb_idx, iq
1658 real(wp) :: pos_x, pos_y, pos_z
1659 real(wp) :: gauss_env, g_norm, f_scale
1660 real(wp) :: a_m, phase_arg
1661 real(wp) :: force_x, force_y, force_z
1662 real(wp) :: rho_local, u_local_x, u_local_y, u_local_z
1663 real(wp) :: adv_offset
1664 logical :: in_box
1665
1666 ! G_bar for exp(-pi/2 * (2x/L)^2) over [-L/2, L/2]: erf(sqrt(pi/2))/sqrt(pi/2) ~ 0.7602
1667 real(wp), parameter :: g_bar = 0.760173_wp
1668
1669 ! Zero momentum and energy RHS for the synthetic turbulence pass
1670
1671
1672# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1673
1674# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1675#if defined(MFC_OpenACC)
1676# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1677!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l)
1678# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1679#elif defined(MFC_OpenMP)
1680# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1681
1682# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1683
1684# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1685
1686# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1687!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l)
1688# 411 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1689#endif
1690# 412 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1691 do i = eqn_idx%mom%beg, eqn_idx%E
1692 do l = 0, p
1693 do k = 0, n
1694 do j = 0, m
1695 rhs_vf(i)%sf(j, k, l) = 0._wp
1696 end do
1697 end do
1698 end do
1699 end do
1700
1701# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1702#if defined(MFC_OpenACC)
1703# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1704!$acc end parallel loop
1705# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1706#elif defined(MFC_OpenMP)
1707# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1708
1709# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1710!$omp end target teams loop
1711# 421 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1712#endif
1713# 422 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1714
1715 ! Pre-compute advection offset on CPU (mytime has no GPU declaration)
1716 adv_offset = synth_u_inf*mytime
1717
1718 do turb_idx = 1, num_turbulent_sources
1719
1720# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1721
1722# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1723#if defined(MFC_OpenACC)
1724# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1725!$acc parallel loop collapse(3) gang vector default(present) &
1726# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1727!$acc& private(j, k, l, n_mode, iq, pos_x, pos_y, pos_z, gauss_env, G_norm, f_scale, a_m, phase_arg, force_x, force_y, force_z, rho_local, u_local_x, u_local_y, u_local_z, in_box)
1728# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1729#elif defined(MFC_OpenMP)
1730# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1731
1732# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1733
1734# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1735
1736# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1737!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1738# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1739!$omp& private(j, k, l, n_mode, iq, pos_x, pos_y, pos_z, gauss_env, G_norm, f_scale, a_m, phase_arg, force_x, force_y, force_z, rho_local, u_local_x, u_local_y, u_local_z, in_box)
1740# 427 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1741#endif
1742# 429 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1743 do l = 0, p
1744 do k = 0, n
1745 do j = 0, m
1746 ! Position relative to forcing-zone center
1747 pos_x = x_cc(j) - turb_pos(turb_idx, 1)
1748 pos_y = 0._wp
1749 pos_z = 0._wp
1750 if (num_dims > 1) pos_y = y_cc(k) - turb_pos(turb_idx, 2)
1751 if (num_dims == 3) pos_z = z_cc(l) - turb_pos(turb_idx, 3)
1752
1753 ! Bounding-box skip
1754 in_box = abs(pos_x) <= 0.5_wp*synth_l(turb_idx, 1)
1755 if (num_dims > 1) in_box = in_box .and. abs(pos_y) <= 0.5_wp*synth_l(turb_idx, 2)
1756 if (num_dims == 3) in_box = in_box .and. abs(pos_z) <= 0.5_wp*synth_l(turb_idx, 3)
1757
1758 if (in_box) then
1759 ! Gaussian envelope, normalised by G_BAR^num_dims
1760 gauss_env = exp(-0.5_wp*pi*(2._wp*pos_x/synth_l(turb_idx, 1))**2)
1761 if (num_dims > 1) gauss_env = gauss_env*exp(-0.5_wp*pi*(2._wp*pos_y/synth_l(turb_idx, 2))**2)
1762 if (num_dims == 3) gauss_env = gauss_env*exp(-0.5_wp*pi*(2._wp*pos_z/synth_l(turb_idx, 3))**2)
1763 g_norm = gauss_env/g_bar**num_dims
1764
1765 ! Accumulate solenoidal force components over all modes.
1766 ! Each mode contributes A_m * cos(phase) in direction e_m
1767 ! (e_m is perpendicular to k_m, precomputed at init).
1768 force_x = 0._wp
1769 force_y = 0._wp
1770 force_z = 0._wp
1771 do n_mode = 1, num_synthetic_wave_numbers
1772 phase_arg = synthetic_k_x(n_mode)*(x_cc(j) - adv_offset) + synthetic_phase(n_mode)
1773 if (num_dims > 1) phase_arg = phase_arg + synthetic_k_y(n_mode)*y_cc(k)
1774 if (num_dims == 3) phase_arg = phase_arg + synthetic_k_z(n_mode)*z_cc(l)
1775 a_m = synthetic_amp(n_mode)*cos(phase_arg)
1776 force_x = force_x + a_m*synthetic_ex(n_mode)
1777 force_y = force_y + a_m*synthetic_ey(n_mode)
1778 force_z = force_z + a_m*synthetic_ez(n_mode)
1779 end do
1780
1781 ! Scale: rho * (U_inf/L_x) * G_norm
1782 ! Mixture density = sum of all partial densities (continuity components)
1783 rho_local = 0._wp
1784 do iq = eqn_idx%cont%beg, eqn_idx%cont%end
1785 rho_local = rho_local + q_prim_vf(iq)%sf(j, k, l)
1786 end do
1787 f_scale = rho_local*(synth_u_inf/synth_l(turb_idx, 1))*g_norm
1788
1789 force_x = force_x*f_scale
1790 force_y = force_y*f_scale
1791 force_z = force_z*f_scale
1792
1793 ! Local velocities for energy update F.u
1794 u_local_x = q_prim_vf(eqn_idx%mom%beg)%sf(j, k, l)
1795 u_local_y = 0._wp
1796 u_local_z = 0._wp
1797 if (num_dims > 1) u_local_y = q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)
1798 if (num_dims == 3) u_local_z = q_prim_vf(eqn_idx%mom%end)%sf(j, k, l)
1799
1800 rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) + force_x
1801 if (num_dims > 1) rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
1802 & l) + force_y
1803 if (num_dims == 3) rhs_vf(eqn_idx%mom%end)%sf(j, k, l) = rhs_vf(eqn_idx%mom%end)%sf(j, k, l) + force_z
1804 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, &
1805 & l) + force_x*u_local_x + force_y*u_local_y + force_z*u_local_z
1806 end if
1807 end do
1808 end do
1809 end do
1810
1811# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1812#if defined(MFC_OpenACC)
1813# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1814!$acc end parallel loop
1815# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1816#elif defined(MFC_OpenMP)
1817# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1818
1819# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1820!$omp end target teams loop
1821# 496 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1822#endif
1823# 497 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1824 end do
1825
1826 end subroutine s_compute_synthetic_forces_rhs
1827
1828 !> Finalize the body forces module
1829 impure subroutine s_finalize_body_forces_module
1830
1831#ifdef MFC_DEBUG
1832# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1833 block
1834# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1835 use iso_fortran_env, only: output_unit
1836# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1837
1838# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1839 print *, 'm_body_forces.fpp:504: ', '@:DEALLOCATE(rhoM)'
1840# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1841
1842# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1843 call flush (output_unit)
1844# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1845 end block
1846# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1847#endif
1848# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1849
1850# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1851#if defined(MFC_OpenACC)
1852# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1853!$acc exit data delete(rhoM)
1854# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1855#elif defined(MFC_OpenMP)
1856# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1857!$omp target exit data map(release:rhoM)
1858# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1859#endif
1860# 504 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1861 deallocate (rhom)
1862# 505 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1863
1864 if (bf_spatial_support) then
1865#ifdef MFC_DEBUG
1866# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1867 block
1868# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1869 use iso_fortran_env, only: output_unit
1870# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1871
1872# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1873 print *, 'm_body_forces.fpp:507: ', '@:DEALLOCATE(freq, phase)'
1874# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1875
1876# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1877 call flush (output_unit)
1878# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1879 end block
1880# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1881#endif
1882# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1883
1884# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1885#if defined(MFC_OpenACC)
1886# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1887!$acc exit data delete(freq, phase)
1888# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1889#elif defined(MFC_OpenMP)
1890# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1891!$omp target exit data map(release:freq, phase)
1892# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1893#endif
1894# 507 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1895 deallocate (freq, phase)
1896# 508 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1897 end if
1898
1899 if (num_synthetic_wave_numbers > 0) then
1900#ifdef MFC_DEBUG
1901# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1902 block
1903# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1904 use iso_fortran_env, only: output_unit
1905# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1906
1907# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1908 print *, 'm_body_forces.fpp:511: ', '@:DEALLOCATE(synthetic_k_x)'
1909# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1910
1911# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1912 call flush (output_unit)
1913# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1914 end block
1915# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1916#endif
1917# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1918
1919# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1920#if defined(MFC_OpenACC)
1921# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1922!$acc exit data delete(synthetic_k_x)
1923# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1924#elif defined(MFC_OpenMP)
1925# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1926!$omp target exit data map(release:synthetic_k_x)
1927# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1928#endif
1929# 511 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1930 deallocate (synthetic_k_x)
1931# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1932#ifdef MFC_DEBUG
1933# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1934 block
1935# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1936 use iso_fortran_env, only: output_unit
1937# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1938
1939# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1940 print *, 'm_body_forces.fpp:512: ', '@:DEALLOCATE(synthetic_phase)'
1941# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1942
1943# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1944 call flush (output_unit)
1945# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1946 end block
1947# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1948#endif
1949# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1950
1951# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1952#if defined(MFC_OpenACC)
1953# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1954!$acc exit data delete(synthetic_phase)
1955# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1956#elif defined(MFC_OpenMP)
1957# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1958!$omp target exit data map(release:synthetic_phase)
1959# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1960#endif
1961# 512 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1962 deallocate (synthetic_phase)
1963# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1964#ifdef MFC_DEBUG
1965# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1966 block
1967# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1968 use iso_fortran_env, only: output_unit
1969# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1970
1971# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1972 print *, 'm_body_forces.fpp:513: ', '@:DEALLOCATE(synthetic_amp)'
1973# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1974
1975# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1976 call flush (output_unit)
1977# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1978 end block
1979# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1980#endif
1981# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1982
1983# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1984#if defined(MFC_OpenACC)
1985# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1986!$acc exit data delete(synthetic_amp)
1987# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1988#elif defined(MFC_OpenMP)
1989# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1990!$omp target exit data map(release:synthetic_amp)
1991# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1992#endif
1993# 513 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1994 deallocate (synthetic_amp)
1995# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1996#ifdef MFC_DEBUG
1997# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
1998 block
1999# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2000 use iso_fortran_env, only: output_unit
2001# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2002
2003# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2004 print *, 'm_body_forces.fpp:514: ', '@:DEALLOCATE(synthetic_ex)'
2005# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2006
2007# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2008 call flush (output_unit)
2009# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2010 end block
2011# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2012#endif
2013# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2014
2015# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2016#if defined(MFC_OpenACC)
2017# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2018!$acc exit data delete(synthetic_ex)
2019# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2020#elif defined(MFC_OpenMP)
2021# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2022!$omp target exit data map(release:synthetic_ex)
2023# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2024#endif
2025# 514 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2026 deallocate (synthetic_ex)
2027# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2028#ifdef MFC_DEBUG
2029# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2030 block
2031# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2032 use iso_fortran_env, only: output_unit
2033# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2034
2035# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2036 print *, 'm_body_forces.fpp:515: ', '@:DEALLOCATE(synthetic_ey)'
2037# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2038
2039# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2040 call flush (output_unit)
2041# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2042 end block
2043# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2044#endif
2045# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2046
2047# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2048#if defined(MFC_OpenACC)
2049# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2050!$acc exit data delete(synthetic_ey)
2051# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2052#elif defined(MFC_OpenMP)
2053# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2054!$omp target exit data map(release:synthetic_ey)
2055# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2056#endif
2057# 515 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2058 deallocate (synthetic_ey)
2059# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2060#ifdef MFC_DEBUG
2061# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2062 block
2063# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2064 use iso_fortran_env, only: output_unit
2065# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2066
2067# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2068 print *, 'm_body_forces.fpp:516: ', '@:DEALLOCATE(synthetic_ez)'
2069# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2070
2071# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2072 call flush (output_unit)
2073# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2074 end block
2075# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2076#endif
2077# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2078
2079# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2080#if defined(MFC_OpenACC)
2081# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2082!$acc exit data delete(synthetic_ez)
2083# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2084#elif defined(MFC_OpenMP)
2085# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2086!$omp target exit data map(release:synthetic_ez)
2087# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2088#endif
2089# 516 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2090 deallocate (synthetic_ez)
2091# 517 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2092 if (num_dims > 1) then
2093#ifdef MFC_DEBUG
2094# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2095 block
2096# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2097 use iso_fortran_env, only: output_unit
2098# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2099
2100# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2101 print *, 'm_body_forces.fpp:518: ', '@:DEALLOCATE(synthetic_k_y)'
2102# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2103
2104# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2105 call flush (output_unit)
2106# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2107 end block
2108# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2109#endif
2110# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2111
2112# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2113#if defined(MFC_OpenACC)
2114# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2115!$acc exit data delete(synthetic_k_y)
2116# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2117#elif defined(MFC_OpenMP)
2118# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2119!$omp target exit data map(release:synthetic_k_y)
2120# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2121#endif
2122# 518 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2123 deallocate (synthetic_k_y)
2124# 519 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2125 end if
2126 if (num_dims == 3) then
2127#ifdef MFC_DEBUG
2128# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2129 block
2130# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2131 use iso_fortran_env, only: output_unit
2132# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2133
2134# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2135 print *, 'm_body_forces.fpp:521: ', '@:DEALLOCATE(synthetic_k_z)'
2136# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2137
2138# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2139 call flush (output_unit)
2140# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2141 end block
2142# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2143#endif
2144# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2145
2146# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2147#if defined(MFC_OpenACC)
2148# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2149!$acc exit data delete(synthetic_k_z)
2150# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2151#elif defined(MFC_OpenMP)
2152# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2153!$omp target exit data map(release:synthetic_k_z)
2154# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2155#endif
2156# 521 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2157 deallocate (synthetic_k_z)
2158# 522 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
2159 end if
2160 end if
2161
2162 end subroutine s_finalize_body_forces_module
2163
2164end module m_body_forces
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1041
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1043
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1043
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1043
m_body_forces
Computes gravitational and body force source terms for the momentum equations.
Definition m_body_forces.fpp.f90:356
m_body_forces::spbf_amp
real(wp) spbf_amp
Definition m_body_forces.fpp.f90:372
m_body_forces::spbf_num_freq
integer, parameter spbf_num_freq
Definition m_body_forces.fpp.f90:371
m_body_forces::phase
real(wp), dimension(:), allocatable phase
Definition m_body_forces.fpp.f90:377
m_body_forces::synthetic_ex
real(wp), dimension(:), allocatable synthetic_ex
Definition m_body_forces.fpp.f90:412
m_body_forces::spbf_yc
real(wp) spbf_yc
Definition m_body_forces.fpp.f90:374
m_body_forces::spbf_conv_vel
real(wp) spbf_conv_vel
Definition m_body_forces.fpp.f90:375
m_body_forces::s_compute_body_force_with_spatial_support
subroutine s_compute_body_force_with_spatial_support(t, bounds)
Apply the body force of Wei & Freund (JFM, 2005).
Definition m_body_forces.fpp.f90:1208
m_body_forces::synthetic_ez
real(wp), dimension(:), allocatable synthetic_ez
Definition m_body_forces.fpp.f90:412
m_body_forces::freq
real(wp), dimension(:), allocatable freq
Definition m_body_forces.fpp.f90:377
m_body_forces::s_compute_synthetic_forces_rhs
subroutine, public s_compute_synthetic_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf)
Compute the synthetic turbulence RHS contribution.
Definition m_body_forces.fpp.f90:1653
m_body_forces::synthetic_phase
real(wp), dimension(:), allocatable synthetic_phase
Definition m_body_forces.fpp.f90:407
m_body_forces::s_initialize_body_force_with_spatial_support
impure subroutine s_initialize_body_force_with_spatial_support
Initialize a body force with spatial support presented in Wei & Freund (JFM, 2005).
Definition m_body_forces.fpp.f90:982
m_body_forces::s_initialize_body_forces_module
impure subroutine, public s_initialize_body_forces_module
Initialize the body forces module. When synthetic_turbulence is enabled, generates random wave vector...
Definition m_body_forces.fpp.f90:444
m_body_forces::spbf_xc
real(wp) spbf_xc
Definition m_body_forces.fpp.f90:373
m_body_forces::synthetic_amp
real(wp), dimension(:), allocatable synthetic_amp
Definition m_body_forces.fpp.f90:407
m_body_forces::synthetic_k_y
real(wp), dimension(:), allocatable synthetic_k_y
Definition m_body_forces.fpp.f90:406
m_body_forces::s_compute_acceleration
subroutine s_compute_acceleration(t)
Compute the acceleration at time t.
Definition m_body_forces.fpp.f90:1168
m_body_forces::spbf_sigma
real(wp) spbf_sigma
Definition m_body_forces.fpp.f90:376
m_body_forces::synthetic_k_z
real(wp), dimension(:), allocatable synthetic_k_z
Definition m_body_forces.fpp.f90:406
m_body_forces::synthetic_ey
real(wp), dimension(:), allocatable synthetic_ey
Definition m_body_forces.fpp.f90:412
m_body_forces::rhom
real(wp), dimension(:,:,:), allocatable rhom
Definition m_body_forces.fpp.f90:378
m_body_forces::num_synthetic_wave_numbers
integer num_synthetic_wave_numbers
Definition m_body_forces.fpp.f90:392
m_body_forces::synthetic_k_x
real(wp), dimension(:), allocatable synthetic_k_x
Definition m_body_forces.fpp.f90:406
m_body_forces::s_compute_mixture_density
subroutine s_compute_mixture_density(q_cons_vf, bounds)
Compute the mixture density at each cell center.
Definition m_body_forces.fpp.f90:1327
m_body_forces::s_finalize_body_forces_module
impure subroutine, public s_finalize_body_forces_module
Finalize the body forces module.
Definition m_body_forces.fpp.f90:1830
m_body_forces::s_compute_body_forces_rhs
subroutine, public s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf, bounds)
Compute the body force source terms for momentum and energy equations.
Definition m_body_forces.fpp.f90:1383
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:853
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:367
m_helper::f_unit_vector
real(wp) function, dimension(3), public f_unit_vector(theta, eta)
Generate a unit vector uniformly distributed on the sphere from two random parameters.
Definition m_helper.fpp.f90:857
m_helper::s_prng_splitmix32
subroutine, public s_prng_splitmix32(var, state)
Uniform draw in [0, 1) (1 only via single-precision rounding) from a 32-bit SplitMix-style generator ...
Definition m_helper.fpp.f90:946
m_helper::f_cross
pure real(wp) function, dimension(3), public f_cross(a, b)
Compute the cross product of two vectors.
Definition m_helper.fpp.f90:828
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:367
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367