MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_pressure_relaxation.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
2!>
3!! @file
4!! @brief Contains module m_pressure_relaxation
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
20# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25
26# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43! New line at end of file is required for FYPP
44# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
45# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
46# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
47# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52
53# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56
57# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70! New line at end of file is required for FYPP
71# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
72
73# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
74# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78
79# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80
81# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149! New line at end of file is required for FYPP
150# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
151# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
152# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
153# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158
159# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162
163# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164
165# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176! New line at end of file is required for FYPP
177# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
178
179# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
180
181# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
182
183# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
184
185# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234! New line at end of file is required for FYPP
235# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
236
237! GPU parallel region (scalar reductions, maxval/minval)
238# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
239
240! GPU parallel loop over threads (most common GPU macro)
241# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
242
243! Required closing for GPU_PARALLEL_LOOP
244# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246! Mark routine for device compilation
247# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249! Declare device-resident data
250# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252! Inner loop within a GPU parallel region
253# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255! Scoped GPU data region
256# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258! Host code with device pointers (for MPI with GPU buffers)
259# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261! Allocate device memory (unscoped)
262# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264! Free device memory
265# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267! Atomic operation on device
268# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270! End atomic capture block
271# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273! Copy data between host and device
274# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275
276! Synchronization barrier
277# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278
279! Import GPU library module (openacc or omp_lib)
280# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
281
282! Emit code only for AMD compiler
283# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284
285! Emit code for non-Cray compilers
286# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
287
288! Emit code only for Cray compiler
289# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290
291! Emit code for non-NVIDIA compilers
292# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
293
294# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296! New line at end of file is required for FYPP
297# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
298
299# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
302! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
303! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
304# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
305
306! Allocate and create GPU device memory
307# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
308
309! Free GPU device memory and deallocate
310# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312! Cray-specific GPU pointer setup for vector fields
313# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
314
315! Cray-specific GPU pointer setup for scalar fields
316# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Cray-specific GPU pointer setup for acoustic source spatials
319# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
320
321# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324! New line at end of file is required for FYPP
325# 7 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp" 2
326
327!> @brief Pressure relaxation for the six-equation multi-component model via Newton--Raphson equilibration and volume-fraction
328!! correction
330
333
334 implicit none
335
338
339 real(wp), allocatable, dimension(:,:) :: res_pr
340
341# 21 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
342#if defined(MFC_OpenACC)
343# 21 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
344!$acc declare create(Res_pr)
345# 21 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
346#elif defined(MFC_OpenMP)
347# 21 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
348!$omp declare target (Res_pr)
349# 21 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
350#endif
351
352contains
353
354 !> Initialize the pressure relaxation module
356
357 integer :: i, j
358
359 if (viscous) then
360#ifdef MFC_DEBUG
361# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
362 block
363# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
364 use iso_fortran_env, only: output_unit
365# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
366
367# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
368 print *, 'm_pressure_relaxation.fpp:31: ', '@:ALLOCATE(Res_pr(1:2, 1:Re_size_max))'
369# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
370
371# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
372 call flush (output_unit)
373# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
374 end block
375# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
376#endif
377# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
378 allocate (res_pr(1:2, 1:re_size_max))
379# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
380
381# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
382
383# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
384#if defined(MFC_OpenACC)
385# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
386!$acc enter data create(Res_pr)
387# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
388#elif defined(MFC_OpenMP)
389# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
390!$omp target enter data map(always,alloc:Res_pr)
391# 31 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
392#endif
393 do i = 1, 2
394 do j = 1, re_size(i)
395 res_pr(i, j) = fluid_pp(re_idx(i, j))%Re(i)
396 end do
397 end do
398
399# 37 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
400#if defined(MFC_OpenACC)
401# 37 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
402!$acc update device(Res_pr, Re_idx, Re_size)
403# 37 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
404#elif defined(MFC_OpenMP)
405# 37 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
406!$omp target update to(Res_pr, Re_idx, Re_size)
407# 37 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
408#endif
409 end if
410
412
413 !> Finalize the pressure relaxation module
415
416 if (viscous) then
417#ifdef MFC_DEBUG
418# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
419 block
420# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
421 use iso_fortran_env, only: output_unit
422# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
423
424# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
425 print *, 'm_pressure_relaxation.fpp:46: ', '@:DEALLOCATE(Res_pr)'
426# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
427
428# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
429 call flush (output_unit)
430# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
431 end block
432# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
433#endif
434# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
435
436# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
437#if defined(MFC_OpenACC)
438# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
439!$acc exit data delete(Res_pr)
440# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
441#elif defined(MFC_OpenMP)
442# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
443!$omp target exit data map(release:Res_pr)
444# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
445#endif
446# 46 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
447 deallocate (res_pr)
448 end if
449
451
452 !> The main pressure relaxation procedure
454
455 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
456 integer :: j, k, l
457
458
459# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
460
461# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
462#if defined(MFC_OpenACC)
463# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
464!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
465# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
466#elif defined(MFC_OpenMP)
467# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
468
469# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
470
471# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
472
473# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
474!$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)
475# 57 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
476#endif
477 do l = 0, p
478 do k = 0, n
479 do j = 0, m
481 end do
482 end do
483 end do
484
485# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
486#if defined(MFC_OpenACC)
487# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
488!$acc end parallel loop
489# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
490#elif defined(MFC_OpenMP)
491# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
492
493# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
494!$omp end target teams loop
495# 65 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
496#endif
497
499
500 !> Process pressure relaxation for a single cell
501 subroutine s_relax_cell_pressure(q_cons_vf, j, k, l)
502
503
504# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
505#if MFC_OpenACC
506# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
507!$acc routine seq
508# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
509#elif MFC_OpenMP
510# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
511
512# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
513
514# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
515!$omp declare target device_type(any)
516# 72 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
517#endif
518
519 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
520 integer, intent(in) :: j, k, l
521
522 ! Volume fraction correction
523 if (mpp_lim) call s_correct_volume_fractions(q_cons_vf, j, k, l)
524
525 ! Pressure equilibration
526 if (s_needs_pressure_relaxation(q_cons_vf, j, k, l)) then
527 call s_equilibrate_pressure(q_cons_vf, j, k, l)
528 end if
529
530 ! Internal energy correction
531 call s_correct_internal_energies(q_cons_vf, j, k, l)
532
533 end subroutine s_relax_cell_pressure
534
535 !> Check if pressure relaxation is needed for this cell
536 logical function s_needs_pressure_relaxation(q_cons_vf, j, k, l)
537
538
539# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
540#if MFC_OpenACC
541# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
542!$acc routine seq
543# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
544#elif MFC_OpenMP
545# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
546
547# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
548
549# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
550!$omp declare target device_type(any)
551# 93 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
552#endif
553
554 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
555 integer, intent(in) :: j, k, l
556 integer :: i
557
559
560# 100 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
561#if defined(MFC_OpenACC)
562# 100 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
563!$acc loop seq
564# 100 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
565#elif defined(MFC_OpenMP)
566# 100 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
567
568# 100 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
569#endif
570 do i = 1, num_fluids
571 if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > (1._wp - sgm_eps)) then
573 end if
574 end do
575
576 end function s_needs_pressure_relaxation
577
578 !> Correct volume fractions to physical bounds
579 subroutine s_correct_volume_fractions(q_cons_vf, j, k, l)
580
581
582# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
583#if MFC_OpenACC
584# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
585!$acc routine seq
586# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
587#elif MFC_OpenMP
588# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
589
590# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
591
592# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
593!$omp declare target device_type(any)
594# 112 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
595#endif
596
597 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
598 integer, intent(in) :: j, k, l
599 real(wp) :: sum_alpha
600 integer :: i
601
602 sum_alpha = 0._wp
603
604# 120 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
605#if defined(MFC_OpenACC)
606# 120 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
607!$acc loop seq
608# 120 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
609#elif defined(MFC_OpenMP)
610# 120 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
611
612# 120 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
613#endif
614 do i = 1, num_fluids
615 if ((q_cons_vf(i + contxb - 1)%sf(j, k, l) < 0._wp) .or. (q_cons_vf(i + advxb - 1)%sf(j, k, l) < 0._wp)) then
616 q_cons_vf(i + contxb - 1)%sf(j, k, l) = 0._wp
617 q_cons_vf(i + advxb - 1)%sf(j, k, l) = 0._wp
618 q_cons_vf(i + intxb - 1)%sf(j, k, l) = 0._wp
619 end if
620 if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > 1._wp) q_cons_vf(i + advxb - 1)%sf(j, k, l) = 1._wp
621 sum_alpha = sum_alpha + q_cons_vf(i + advxb - 1)%sf(j, k, l)
622 end do
623
624
625# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
626#if defined(MFC_OpenACC)
627# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
628!$acc loop seq
629# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
630#elif defined(MFC_OpenMP)
631# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
632
633# 131 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
634#endif
635 do i = 1, num_fluids
636 q_cons_vf(i + advxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, l)/sum_alpha
637 end do
638
639 end subroutine s_correct_volume_fractions
640
641 !> Main pressure equilibration using Newton-Raphson
642 subroutine s_equilibrate_pressure(q_cons_vf, j, k, l)
643
644
645# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
646#if MFC_OpenACC
647# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
648!$acc routine seq
649# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
650#elif MFC_OpenMP
651# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
652
653# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
654
655# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
656!$omp declare target device_type(any)
657# 141 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
658#endif
659
660 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
661 integer, intent(in) :: j, k, l
662 real(wp) :: pres_relax, f_pres, df_pres
663# 149 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
664 real(wp), dimension(num_fluids) :: pres_K_init, rho_K_s
665# 151 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
666 integer, parameter :: MAX_ITER = 50
667 ! Pressure relaxation convergence tolerance
668 real(wp), parameter :: TOLERANCE = 1.e-10_wp
669 integer :: iter, i
670
671 ! Initialize pressures
672 pres_relax = 0._wp
673
674# 158 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
675#if defined(MFC_OpenACC)
676# 158 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
677!$acc loop seq
678# 158 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
679#elif defined(MFC_OpenMP)
680# 158 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
681
682# 158 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
683#endif
684 do i = 1, num_fluids
685 if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then
686 pres_k_init(i) = (q_cons_vf(i + intxb - 1)%sf(j, k, l)/q_cons_vf(i + advxb - 1)%sf(j, k, l) - pi_infs(i))/gammas(i)
687 if (pres_k_init(i) <= -(1._wp - 1.e-8_wp)*ps_inf(i) + 1.e-8_wp) pres_k_init(i) = -(1._wp - 1.e-8_wp)*ps_inf(i) &
688 & + 1.e-8_wp
689 else
690 pres_k_init(i) = 0._wp
691 end if
692 pres_relax = pres_relax + q_cons_vf(i + advxb - 1)%sf(j, k, l)*pres_k_init(i)
693 end do
694
695 ! Newton-Raphson iteration
696 f_pres = 1.e-9_wp
697 df_pres = 1.e9_wp
698
699# 173 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
700#if defined(MFC_OpenACC)
701# 173 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
702!$acc loop seq
703# 173 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
704#elif defined(MFC_OpenMP)
705# 173 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
706
707# 173 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
708#endif
709 do iter = 0, max_iter - 1
710 if (abs(f_pres) > tolerance) then
711 pres_relax = pres_relax - f_pres/df_pres
712
713 ! Enforce pressure bounds
714 do i = 1, num_fluids
715 if (pres_relax <= -(1._wp - 1.e-8_wp)*ps_inf(i) + 1.e-8_wp) pres_relax = -(1._wp - 1.e-8_wp)*ps_inf(i) &
716 & + 1.e-8_wp
717 end do
718
719 ! Newton-Raphson step
720 f_pres = -1._wp
721 df_pres = 0._wp
722
723# 187 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
724#if defined(MFC_OpenACC)
725# 187 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
726!$acc loop seq
727# 187 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
728#elif defined(MFC_OpenMP)
729# 187 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
730
731# 187 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
732#endif
733 do i = 1, num_fluids
734 if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then
735 ! Isentropic relation: rho = rho0 * (p/p0)^(1/gamma), Saurel et al. JFM (2009)
736 rho_k_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/max(q_cons_vf(i + advxb - 1)%sf(j, k, l), &
737 & sgm_eps)*((pres_relax + ps_inf(i))/(pres_k_init(i) + ps_inf(i)))**(1._wp/gs_min(i))
738 f_pres = f_pres + q_cons_vf(i + contxb - 1)%sf(j, k, l)/rho_k_s(i)
739 df_pres = df_pres - q_cons_vf(i + contxb - 1)%sf(j, k, l)/(gs_min(i)*rho_k_s(i)*(pres_relax + ps_inf(i)))
740 end if
741 end do
742 end if
743 end do
744
745 ! Update volume fractions
746
747# 201 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
748#if defined(MFC_OpenACC)
749# 201 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
750!$acc loop seq
751# 201 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
752#elif defined(MFC_OpenMP)
753# 201 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
754
755# 201 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
756#endif
757 do i = 1, num_fluids
758 if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) q_cons_vf(i + advxb - 1)%sf(j, k, &
759 & l) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/rho_k_s(i)
760 end do
761
762 end subroutine s_equilibrate_pressure
763
764 !> Correct internal energies using equilibrated pressure
765 subroutine s_correct_internal_energies(q_cons_vf, j, k, l)
766
767
768# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
769#if MFC_OpenACC
770# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
771!$acc routine seq
772# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
773#elif MFC_OpenMP
774# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
775
776# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
777
778# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
779!$omp declare target device_type(any)
780# 212 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
781#endif
782
783 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
784 integer, intent(in) :: j, k, l
785# 219 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
786 real(wp), dimension(num_fluids) :: alpha_rho, alpha
787# 221 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
788 real(wp) :: rho, dyn_pres, gamma, pi_inf, pres_relax, sum_alpha
789 real(wp), dimension(2) :: Re
790 integer :: i, q
791
792
793# 225 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
794#if defined(MFC_OpenACC)
795# 225 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
796!$acc loop seq
797# 225 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
798#elif defined(MFC_OpenMP)
799# 225 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
800
801# 225 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
802#endif
803 do i = 1, num_fluids
804 alpha_rho(i) = q_cons_vf(i)%sf(j, k, l)
805 alpha(i) = q_cons_vf(e_idx + i)%sf(j, k, l)
806 end do
807
808 ! Compute mixture properties (combined bubble and standard logic)
809 rho = 0._wp
810 gamma = 0._wp
811 pi_inf = 0._wp
812
813 if (bubbles_euler) then
814 if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then
815
816# 238 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
817#if defined(MFC_OpenACC)
818# 238 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
819!$acc loop seq
820# 238 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
821#elif defined(MFC_OpenMP)
822# 238 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
823
824# 238 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
825#endif
826 do i = 1, num_fluids
827 rho = rho + alpha_rho(i)
828 gamma = gamma + alpha(i)*gammas(i)
829 pi_inf = pi_inf + alpha(i)*pi_infs(i)
830 end do
831 else if ((model_eqns == 2) .and. (num_fluids > 2)) then
832
833# 245 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
834#if defined(MFC_OpenACC)
835# 245 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
836!$acc loop seq
837# 245 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
838#elif defined(MFC_OpenMP)
839# 245 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
840
841# 245 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
842#endif
843 do i = 1, num_fluids - 1
844 rho = rho + alpha_rho(i)
845 gamma = gamma + alpha(i)*gammas(i)
846 pi_inf = pi_inf + alpha(i)*pi_infs(i)
847 end do
848 else
849 rho = alpha_rho(1)
850 gamma = gammas(1)
851 pi_inf = pi_infs(1)
852 end if
853 else
854 sum_alpha = 0._wp
855 if (mpp_lim) then
856
857# 259 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
858#if defined(MFC_OpenACC)
859# 259 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
860!$acc loop seq
861# 259 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
862#elif defined(MFC_OpenMP)
863# 259 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
864
865# 259 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
866#endif
867 do i = 1, num_fluids
868 alpha_rho(i) = max(0._wp, alpha_rho(i))
869 alpha(i) = min(max(0._wp, alpha(i)), 1._wp)
870 sum_alpha = sum_alpha + alpha(i)
871 end do
872 alpha = alpha/max(sum_alpha, sgm_eps)
873 end if
874
875
876# 268 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
877#if defined(MFC_OpenACC)
878# 268 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
879!$acc loop seq
880# 268 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
881#elif defined(MFC_OpenMP)
882# 268 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
883
884# 268 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
885#endif
886 do i = 1, num_fluids
887 rho = rho + alpha_rho(i)
888 gamma = gamma + alpha(i)*gammas(i)
889 pi_inf = pi_inf + alpha(i)*pi_infs(i)
890 end do
891
892 if (viscous) then
893
894# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
895#if defined(MFC_OpenACC)
896# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
897!$acc loop seq
898# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
899#elif defined(MFC_OpenMP)
900# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
901
902# 276 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
903#endif
904 do i = 1, 2
905 re(i) = dflt_real
906 if (re_size(i) > 0) re(i) = 0._wp
907
908# 280 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
909#if defined(MFC_OpenACC)
910# 280 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
911!$acc loop seq
912# 280 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
913#elif defined(MFC_OpenMP)
914# 280 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
915
916# 280 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
917#endif
918 do q = 1, re_size(i)
919 re(i) = alpha(re_idx(i, q))/res_pr(i, q) + re(i)
920 end do
921 re(i) = 1._wp/max(re(i), sgm_eps)
922 end do
923 end if
924 end if
925
926 ! Compute dynamic pressure and update internal energies
927 dyn_pres = 0._wp
928
929# 291 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
930#if defined(MFC_OpenACC)
931# 291 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
932!$acc loop seq
933# 291 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
934#elif defined(MFC_OpenMP)
935# 291 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
936
937# 291 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
938#endif
939 do i = momxb, momxe
940 dyn_pres = dyn_pres + 5.e-1_wp*q_cons_vf(i)%sf(j, k, l)*q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps)
941 end do
942
943 pres_relax = (q_cons_vf(e_idx)%sf(j, k, l) - dyn_pres - pi_inf)/gamma
944
945
946# 298 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
947#if defined(MFC_OpenACC)
948# 298 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
949!$acc loop seq
950# 298 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
951#elif defined(MFC_OpenMP)
952# 298 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
953
954# 298 "/home/runner/work/MFC/MFC/src/simulation/m_pressure_relaxation.fpp"
955#endif
956 do i = 1, num_fluids
957 q_cons_vf(i + intxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, l)*(gammas(i)*pres_relax + pi_infs(i))
958 end do
959
960 end subroutine s_correct_internal_energies
961
962end module m_pressure_relaxation
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
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, dimension(2) re_size
integer, dimension(:,:), allocatable re_idx
logical viscous
Viscous effects.
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Stiffened gas EOS parameters and Reynolds numbers per fluid.
Pressure relaxation for the six-equation multi-component model via Newton–Raphson equilibration and v...
subroutine s_relax_cell_pressure(q_cons_vf, j, k, l)
Process pressure relaxation for a single cell.
real(wp), dimension(:,:), allocatable res_pr
impure subroutine, public s_finalize_pressure_relaxation_module
Finalize the pressure relaxation module.
subroutine s_equilibrate_pressure(q_cons_vf, j, k, l)
Main pressure equilibration using Newton-Raphson.
subroutine, public s_pressure_relaxation_procedure(q_cons_vf)
The main pressure relaxation procedure.
logical function s_needs_pressure_relaxation(q_cons_vf, j, k, l)
Check if pressure relaxation is needed for this cell.
subroutine s_correct_internal_energies(q_cons_vf, j, k, l)
Correct internal energies using equilibrated pressure.
subroutine s_correct_volume_fractions(q_cons_vf, j, k, l)
Correct volume fractions to physical bounds.
impure subroutine, public s_initialize_pressure_relaxation_module
Initialize the pressure relaxation module.