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