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