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! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226! GPU parallel region (scalar reductions, maxval/minval)
227# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
228
229! GPU parallel loop over threads (most common GPU macro)
230# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232! Required closing for GPU_PARALLEL_LOOP
233# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! Mark routine for device compilation
236# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Declare device-resident data
239# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Inner loop within a GPU parallel region
242# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Scoped GPU data region
245# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Host code with device pointers (for MPI with GPU buffers)
248# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Allocate device memory (unscoped)
251# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Free device memory
254# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Atomic operation on device
257# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! End atomic capture block
260# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Copy data between host and device
263# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Synchronization barrier
266# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Import GPU library module (openacc or omp_lib)
269# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Emit code only for AMD compiler
272# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Emit code for non-Cray compilers
275# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for Cray compiler
278# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-NVIDIA compilers
281# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285! New line at end of file is required for FYPP
286# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
287
288# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
291! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
292! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
293# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295! Allocate and create GPU device memory
296# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298! Free GPU device memory and deallocate
299# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Cray-specific GPU pointer setup for vector fields
302# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Cray-specific GPU pointer setup for scalar fields
305# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for acoustic source spatials
308# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313! New line at end of file is required for FYPP
314# 6 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp" 2
315
316!> @brief Computes gravitational and user-defined body force source terms for the momentum equations
317module m_body_forces
318
319 use m_derived_types
320 use m_global_parameters
321 use m_variables_conversion
322 use m_nvtx
323
324 ! $:USE_GPU_MODULE()
325
326 implicit none
327
328 private
329 public :: s_compute_body_forces_rhs, s_initialize_body_forces_module, s_finalize_body_forces_module
330
331 real(wp), allocatable, dimension(:,:,:) :: rhom
332
333# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
334#if defined(MFC_OpenACC)
335# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
336!$acc declare create(rhoM)
337# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
338#elif defined(MFC_OpenMP)
339# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
340!$omp declare target (rhoM)
341# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
342#endif
343
344contains
345
346 !> Initialize the body forces module
347 impure subroutine s_initialize_body_forces_module
348
349 if (n > 0) then
350 if (p > 0) then
351#ifdef MFC_DEBUG
352# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
353 block
354# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
355 use iso_fortran_env, only: output_unit
356# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
357
358# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
359 print *, 'm_body_forces.fpp:32: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))'
360# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
361
362# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
363 call flush (output_unit)
364# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
365 end block
366# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
367#endif
368# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
369 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
370# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
371
372# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
373
374# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
375#if defined(MFC_OpenACC)
376# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
377!$acc enter data create(rhoM)
378# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
379#elif defined(MFC_OpenMP)
380# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
381!$omp target enter data map(always,alloc:rhoM)
382# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
383#endif
384 else
385#ifdef MFC_DEBUG
386# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
387 block
388# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
389 use iso_fortran_env, only: output_unit
390# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
391
392# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
393 print *, 'm_body_forces.fpp:34: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))'
394# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
395
396# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
397 call flush (output_unit)
398# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
399 end block
400# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
401#endif
402# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
403 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
404# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
405
406# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
407
408# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
409#if defined(MFC_OpenACC)
410# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
411!$acc enter data create(rhoM)
412# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
413#elif defined(MFC_OpenMP)
414# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
415!$omp target enter data map(always,alloc:rhoM)
416# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
417#endif
418 end if
419 else
420#ifdef MFC_DEBUG
421# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
422 block
423# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
424 use iso_fortran_env, only: output_unit
425# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
426
427# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
428 print *, 'm_body_forces.fpp:37: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, 0:0, 0:0))'
429# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
430
431# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
432 call flush (output_unit)
433# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
434 end block
435# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
436#endif
437# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
438 allocate (rhom(-buff_size:buff_size + m, 0:0, 0:0))
439# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
440
441# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
442
443# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
444#if defined(MFC_OpenACC)
445# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
446!$acc enter data create(rhoM)
447# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
448#elif defined(MFC_OpenMP)
449# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
450!$omp target enter data map(always,alloc:rhoM)
451# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
452#endif
453 end if
454
455 end subroutine s_initialize_body_forces_module
456
457 !> Compute the acceleration at time t
458 subroutine s_compute_acceleration(t)
459
460 real(wp), intent(in) :: t
461
462# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
463 if (bf_x) then
464 accel_bf(1) = g_x + k_x*sin(w_x*t - p_x)
465 end if
466# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
467 if (bf_y) then
468 accel_bf(2) = g_y + k_y*sin(w_y*t - p_y)
469 end if
470# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
471 if (bf_z) then
472 accel_bf(3) = g_z + k_z*sin(w_z*t - p_z)
473 end if
474# 52 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
475
476
477# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
478#if defined(MFC_OpenACC)
479# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
480!$acc update device(accel_bf)
481# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
482#elif defined(MFC_OpenMP)
483# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
484!$omp target update to(accel_bf)
485# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
486#endif
487
488 end subroutine s_compute_acceleration
489
490 !> Compute the mixture density at each cell center
491 subroutine s_compute_mixture_density(q_cons_vf)
492
493 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
494 integer :: i, j, k, l !< standard iterators
495
496
497# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
498
499# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
500#if defined(MFC_OpenACC)
501# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
502!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
503# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
504#elif defined(MFC_OpenMP)
505# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
506
507# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
508
509# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
510
511# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
512!$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)
513# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
514#endif
515 do l = 0, p
516 do k = 0, n
517 do j = 0, m
518 rhom(j, k, l) = 0._wp
519 do i = 1, num_fluids
520 rhom(j, k, l) = rhom(j, k, l) + q_cons_vf(contxb + i - 1)%sf(j, k, l)
521 end do
522 end do
523 end do
524 end do
525
526# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
527#if defined(MFC_OpenACC)
528# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
529!$acc end parallel loop
530# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
531#elif defined(MFC_OpenMP)
532# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
533
534# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
535!$omp end target teams loop
536# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
537#endif
538
539 end subroutine s_compute_mixture_density
540
541 !> Compute the body force source terms for momentum and energy equations
542 subroutine s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf)
543
544 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
545 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
546 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
547 integer :: i, j, k, l !< Loop variables
548
549 call s_compute_acceleration(mytime)
550 call s_compute_mixture_density(q_cons_vf)
551
552
553# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
554
555# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
556#if defined(MFC_OpenACC)
557# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
558!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l)
559# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
560#elif defined(MFC_OpenMP)
561# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
562
563# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
564
565# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
566
567# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
568!$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)
569# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
570#endif
571 do i = momxb, e_idx
572 do l = 0, p
573 do k = 0, n
574 do j = 0, m
575 rhs_vf(i)%sf(j, k, l) = 0._wp
576 end do
577 end do
578 end do
579 end do
580
581# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
582#if defined(MFC_OpenACC)
583# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
584!$acc end parallel loop
585# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
586#elif defined(MFC_OpenMP)
587# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
588
589# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
590!$omp end target teams loop
591# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
592#endif
593
594 if (bf_x) then ! x-direction body forces
595
596
597# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
598
599# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
600#if defined(MFC_OpenACC)
601# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
602!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
603# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
604#elif defined(MFC_OpenMP)
605# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
606
607# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
608
609# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
610
611# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
612!$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)
613# 103 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
614#endif
615 do l = 0, p
616 do k = 0, n
617 do j = 0, m
618 rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, l) + rhom(j, k, l)*accel_bf(1)
619 rhs_vf(e_idx)%sf(j, k, l) = rhs_vf(e_idx)%sf(j, k, l) + q_cons_vf(momxb)%sf(j, k, l)*accel_bf(1)
620 end do
621 end do
622 end do
623
624# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
625#if defined(MFC_OpenACC)
626# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
627!$acc end parallel loop
628# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
629#elif defined(MFC_OpenMP)
630# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
631
632# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
633!$omp end target teams loop
634# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
635#endif
636 end if
637
638 if (bf_y) then ! y-direction body forces
639
640
641# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
642
643# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
644#if defined(MFC_OpenACC)
645# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
646!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
647# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
648#elif defined(MFC_OpenMP)
649# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
650
651# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
652
653# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
654
655# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
656!$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)
657# 117 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
658#endif
659 do l = 0, p
660 do k = 0, n
661 do j = 0, m
662 rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + rhom(j, k, l)*accel_bf(2)
663 rhs_vf(e_idx)%sf(j, k, l) = rhs_vf(e_idx)%sf(j, k, l) + q_cons_vf(momxb + 1)%sf(j, k, l)*accel_bf(2)
664 end do
665 end do
666 end do
667
668# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
669#if defined(MFC_OpenACC)
670# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
671!$acc end parallel loop
672# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
673#elif defined(MFC_OpenMP)
674# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
675
676# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
677!$omp end target teams loop
678# 126 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
679#endif
680 end if
681
682 if (bf_z) then ! z-direction body forces
683
684
685# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
686
687# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
688#if defined(MFC_OpenACC)
689# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
690!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
691# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
692#elif defined(MFC_OpenMP)
693# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
694
695# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
696
697# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
698
699# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
700!$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)
701# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
702#endif
703 do l = 0, p
704 do k = 0, n
705 do j = 0, m
706 rhs_vf(momxe)%sf(j, k, l) = rhs_vf(momxe)%sf(j, k, l) + rhom(j, k, l)*accel_bf(3)
707 rhs_vf(e_idx)%sf(j, k, l) = rhs_vf(e_idx)%sf(j, k, l) + q_cons_vf(momxe)%sf(j, k, l)*accel_bf(3)
708 end do
709 end do
710 end do
711
712# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
713#if defined(MFC_OpenACC)
714# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
715!$acc end parallel loop
716# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
717#elif defined(MFC_OpenMP)
718# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
719
720# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
721!$omp end target teams loop
722# 140 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
723#endif
724 end if
725
726 end subroutine s_compute_body_forces_rhs
727
728 !> Finalize the body forces module
729 impure subroutine s_finalize_body_forces_module
730
731#ifdef MFC_DEBUG
732# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
733 block
734# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
735 use iso_fortran_env, only: output_unit
736# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
737
738# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
739 print *, 'm_body_forces.fpp:148: ', '@:DEALLOCATE(rhoM)'
740# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
741
742# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
743 call flush (output_unit)
744# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
745 end block
746# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
747#endif
748# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
749
750# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
751#if defined(MFC_OpenACC)
752# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
753!$acc exit data delete(rhoM)
754# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
755#elif defined(MFC_OpenMP)
756# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
757!$omp target exit data map(release:rhoM)
758# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
759#endif
760# 148 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
761 deallocate (rhom)
762
763 end subroutine s_finalize_body_forces_module
764
765end module m_body_forces
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1062
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1064
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1064
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1064
m_body_forces
Computes gravitational and user-defined body force source terms for the momentum equations.
Definition m_body_forces.fpp.f90:317
m_body_forces::s_compute_body_forces_rhs
subroutine, public s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf)
Compute the body force source terms for momentum and energy equations.
Definition m_body_forces.fpp.f90:543
m_body_forces::s_initialize_body_forces_module
impure subroutine, public s_initialize_body_forces_module
Initialize the body forces module.
Definition m_body_forces.fpp.f90:348
m_body_forces::s_compute_mixture_density
subroutine s_compute_mixture_density(q_cons_vf)
Compute the mixture density at each cell center.
Definition m_body_forces.fpp.f90:492
m_body_forces::s_compute_acceleration
subroutine s_compute_acceleration(t)
Compute the acceleration at time t.
Definition m_body_forces.fpp.f90:459
m_body_forces::rhom
real(wp), dimension(:,:,:), allocatable rhom
Definition m_body_forces.fpp.f90:331
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:730
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:914
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:352
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:352
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:328