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. NVIDIA unified memory page placement hint
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
324
328 use m_nvtx
329
330 ! $:USE_GPU_MODULE()
331
332 implicit none
333
334 private
336
337 real(wp), allocatable, dimension(:,:,:) :: rhom
338
339# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
340#if defined(MFC_OpenACC)
341# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
342!$acc declare create(rhoM)
343# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
344#elif defined(MFC_OpenMP)
345# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
346!$omp declare target (rhoM)
347# 23 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
348#endif
349
350contains
351
352 !> Initialize the body forces module
354
355 if (n > 0) then
356 if (p > 0) then
357#ifdef MFC_DEBUG
358# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
359 block
360# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
361 use iso_fortran_env, only: output_unit
362# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
363
364# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
365 print *, 'm_body_forces.fpp:32: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))'
366# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
367
368# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
369 call flush (output_unit)
370# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
371 end block
372# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
373#endif
374# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
375 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, -buff_size:buff_size + p))
376# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
377
378# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
379
380# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
381#if defined(MFC_OpenACC)
382# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
383!$acc enter data create(rhoM)
384# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
385#elif defined(MFC_OpenMP)
386# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
387!$omp target enter data map(always,alloc:rhoM)
388# 32 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
389#endif
390 else
391#ifdef MFC_DEBUG
392# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
393 block
394# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
395 use iso_fortran_env, only: output_unit
396# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
397
398# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
399 print *, 'm_body_forces.fpp:34: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))'
400# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
401
402# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
403 call flush (output_unit)
404# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
405 end block
406# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
407#endif
408# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
409 allocate (rhom(-buff_size:buff_size + m, -buff_size:buff_size + n, 0:0))
410# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
411
412# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
413
414# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
415#if defined(MFC_OpenACC)
416# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
417!$acc enter data create(rhoM)
418# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
419#elif defined(MFC_OpenMP)
420# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
421!$omp target enter data map(always,alloc:rhoM)
422# 34 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
423#endif
424 end if
425 else
426#ifdef MFC_DEBUG
427# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
428 block
429# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
430 use iso_fortran_env, only: output_unit
431# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
432
433# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
434 print *, 'm_body_forces.fpp:37: ', '@:ALLOCATE(rhoM(-buff_size:buff_size + m, 0:0, 0:0))'
435# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
436
437# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
438 call flush (output_unit)
439# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
440 end block
441# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
442#endif
443# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
444 allocate (rhom(-buff_size:buff_size + m, 0:0, 0:0))
445# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
446
447# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
448
449# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
450#if defined(MFC_OpenACC)
451# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
452!$acc enter data create(rhoM)
453# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
454#elif defined(MFC_OpenMP)
455# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
456!$omp target enter data map(always,alloc:rhoM)
457# 37 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
458#endif
459 end if
460
462
463 !> Compute the acceleration at time t
465
466 real(wp), intent(in) :: t
467
468# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
469 if (bf_x) then
470 accel_bf(1) = g_x + k_x*sin(w_x*t - p_x)
471 end if
472# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
473 if (bf_y) then
474 accel_bf(2) = g_y + k_y*sin(w_y*t - p_y)
475 end if
476# 48 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
477 if (bf_z) then
478 accel_bf(3) = g_z + k_z*sin(w_z*t - p_z)
479 end if
480# 52 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
481
482
483# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
484#if defined(MFC_OpenACC)
485# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
486!$acc update device(accel_bf)
487# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
488#elif defined(MFC_OpenMP)
489# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
490!$omp target update to(accel_bf)
491# 53 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
492#endif
493
494 end subroutine s_compute_acceleration
495
496 !> Compute the mixture density at each cell center
497 subroutine s_compute_mixture_density(q_cons_vf)
498
499 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
500 integer :: i, j, k, l !< standard iterators
501
502
503# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
504
505# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
506#if defined(MFC_OpenACC)
507# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
508!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
509# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
510#elif defined(MFC_OpenMP)
511# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
512
513# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
514
515# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
516
517# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
518!$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)
519# 63 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
520#endif
521 do l = 0, p
522 do k = 0, n
523 do j = 0, m
524 rhom(j, k, l) = 0._wp
525 do i = 1, num_fluids
526 rhom(j, k, l) = rhom(j, k, l) + q_cons_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l)
527 end do
528 end do
529 end do
530 end do
531
532# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
533#if defined(MFC_OpenACC)
534# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
535!$acc end parallel loop
536# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
537#elif defined(MFC_OpenMP)
538# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
539
540# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
541!$omp end target teams loop
542# 74 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
543#endif
544
545 end subroutine s_compute_mixture_density
546
547 !> Compute the body force source terms for momentum and energy equations
548 subroutine s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf)
549
550 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
551 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
552 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
553 integer :: i, j, k, l !< Loop variables
554
555 call s_compute_acceleration(mytime)
557
558
559# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
560
561# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
562#if defined(MFC_OpenACC)
563# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
564!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l)
565# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
566#elif defined(MFC_OpenMP)
567# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
568
569# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
570
571# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
572
573# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
574!$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)
575# 89 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
576#endif
577 do i = eqn_idx%mom%beg, eqn_idx%E
578 do l = 0, p
579 do k = 0, n
580 do j = 0, m
581 rhs_vf(i)%sf(j, k, l) = 0._wp
582 end do
583 end do
584 end do
585 end do
586
587# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
588#if defined(MFC_OpenACC)
589# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
590!$acc end parallel loop
591# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
592#elif defined(MFC_OpenMP)
593# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
594
595# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
596!$omp end target teams loop
597# 99 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
598#endif
599
600 if (bf_x) then ! x-direction body forces
601
602# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
603
604# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
605#if defined(MFC_OpenACC)
606# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
607!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
608# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
609#elif defined(MFC_OpenMP)
610# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
611
612# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
613
614# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
615
616# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
617!$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)
618# 102 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
619#endif
620 do l = 0, p
621 do k = 0, n
622 do j = 0, m
623 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)
624 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, &
625 & l)*accel_bf(1)
626 end do
627 end do
628 end do
629
630# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
631#if defined(MFC_OpenACC)
632# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
633!$acc end parallel loop
634# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
635#elif defined(MFC_OpenMP)
636# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
637
638# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
639!$omp end target teams loop
640# 112 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
641#endif
642 end if
643
644 if (bf_y) then ! y-direction body forces
645
646# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
647
648# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
649#if defined(MFC_OpenACC)
650# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
651!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
652# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
653#elif defined(MFC_OpenMP)
654# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
655
656# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
657
658# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
659
660# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
661!$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)
662# 116 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
663#endif
664 do l = 0, p
665 do k = 0, n
666 do j = 0, m
667 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, &
668 & l)*accel_bf(2)
669 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, &
670 & l)*accel_bf(2)
671 end do
672 end do
673 end do
674
675# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
676#if defined(MFC_OpenACC)
677# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
678!$acc end parallel loop
679# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
680#elif defined(MFC_OpenMP)
681# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
682
683# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
684!$omp end target teams loop
685# 127 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
686#endif
687 end if
688
689 if (bf_z) then ! z-direction body forces
690
691# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
692
693# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
694#if defined(MFC_OpenACC)
695# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
696!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
697# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
698#elif defined(MFC_OpenMP)
699# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
700
701# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
702
703# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
704
705# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
706!$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)
707# 131 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
708#endif
709 do l = 0, p
710 do k = 0, n
711 do j = 0, m
712 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)
713 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, &
714 & l)*accel_bf(3)
715 end do
716 end do
717 end do
718
719# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
720#if defined(MFC_OpenACC)
721# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
722!$acc end parallel loop
723# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
724#elif defined(MFC_OpenMP)
725# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
726
727# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
728!$omp end target teams loop
729# 141 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
730#endif
731 end if
732
733 end subroutine s_compute_body_forces_rhs
734
735 !> Finalize the body forces module
737
738#ifdef MFC_DEBUG
739# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
740 block
741# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
742 use iso_fortran_env, only: output_unit
743# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
744
745# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
746 print *, 'm_body_forces.fpp:149: ', '@:DEALLOCATE(rhoM)'
747# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
748
749# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
750 call flush (output_unit)
751# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
752 end block
753# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
754#endif
755# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
756
757# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
758#if defined(MFC_OpenACC)
759# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
760!$acc exit data delete(rhoM)
761# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
762#elif defined(MFC_OpenMP)
763# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
764!$omp target exit data map(release:rhoM)
765# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
766#endif
767# 149 "/home/runner/work/MFC/MFC/src/simulation/m_body_forces.fpp"
768 deallocate (rhom)
769
770 end subroutine s_finalize_body_forces_module
771
772end module m_body_forces
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Computes gravitational and body force source terms for the momentum equations.
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.
impure subroutine, public s_initialize_body_forces_module
Initialize the body forces module.
subroutine s_compute_mixture_density(q_cons_vf)
Compute the mixture density at each cell center.
subroutine s_compute_acceleration(t)
Compute the acceleration at time t.
real(wp), dimension(:,:,:), allocatable rhom
impure subroutine, public s_finalize_body_forces_module
Finalize the body forces module.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
integer buff_size
Number of ghost cells for boundary condition storage.
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.