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