MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_muscl.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
2!>
3!! @file
4!! @brief Contains module m_muscl
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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp" 2
354
355!> @brief MUSCL reconstruction with interface sharpening for contact-preserving advection
356module m_muscl
357
358 use m_derived_types
359 use m_global_parameters
360 use m_variables_conversion
361 use m_constants, only: muscl_order_first_order, muscl_order_second_order, muscl_lim_unlimited, muscl_lim_minmod, &
362 & muscl_lim_mc, muscl_lim_van_albada, muscl_lim_van_leer, muscl_lim_superbee
363#ifdef MFC_OpenACC
364 use openacc
365#endif
366
367 use m_mpi_proxy
368 use m_helper
369 use m_thinc
370 use m_nvtx
371
372 private; public :: s_initialize_muscl_module, s_muscl, s_finalize_muscl_module
373
374 integer :: v_size
375
376# 27 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
377#if defined(MFC_OpenACC)
378# 27 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
379!$acc declare create(v_size)
380# 27 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
381#elif defined(MFC_OpenMP)
382# 27 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
383!$omp declare target (v_size)
384# 27 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
385#endif
386# 28 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
387
388 type(int_bounds_info) :: is1_muscl, is2_muscl, is3_muscl
389
390# 30 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
391#if defined(MFC_OpenACC)
392# 30 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
393!$acc declare create(is1_muscl, is2_muscl, is3_muscl)
394# 30 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
395#elif defined(MFC_OpenMP)
396# 30 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
397!$omp declare target (is1_muscl, is2_muscl, is3_muscl)
398# 30 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
399#endif
400# 31 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
401
402 !> @name The cell-average variables that will be MUSCL-reconstructed, unpacked into an array for performance
403 !> @{
404 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_ws_muscl
405 !> @}
406
407# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
408#if defined(MFC_OpenACC)
409# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
410!$acc declare create(v_rs_ws_muscl)
411# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
412#elif defined(MFC_OpenMP)
413# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
414!$omp declare target (v_rs_ws_muscl)
415# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
416#endif
417# 37 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
418
419contains
420
421 !> Allocate and initialize MUSCL reconstruction working arrays
422 subroutine s_initialize_muscl_module()
423
424 ! Initializing in x-direction
425 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
426 if (n == 0) then
427 is2_muscl%beg = 0
428 else
429 is2_muscl%beg = -buff_size
430 end if
431
432 is2_muscl%end = n - is2_muscl%beg
433
434 if (p == 0) then
435 is3_muscl%beg = 0
436 else
437 is3_muscl%beg = -buff_size
438 end if
439
440 is3_muscl%end = p - is3_muscl%beg
441
442#ifdef MFC_DEBUG
443# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
444 block
445# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
446 use iso_fortran_env, only: output_unit
447# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
448
449# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
450 print *, 'm_muscl.fpp:61: ', '@:ALLOCATE(v_rs_ws_muscl(is1_muscl%beg:is1_muscl%end, is2_muscl%beg:is2_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))'
451# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
452
453# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
454 call flush (output_unit)
455# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
456 end block
457# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
458#endif
459# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
460 allocate (v_rs_ws_muscl(is1_muscl%beg:is1_muscl%end, is2_muscl%beg:is2_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))
461# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
462
463# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
464
465# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
466#if defined(MFC_OpenACC)
467# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
468!$acc enter data create(v_rs_ws_muscl)
469# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
470#elif defined(MFC_OpenMP)
471# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
472!$omp target enter data map(always,alloc:v_rs_ws_muscl)
473# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
474#endif
475# 62 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
476
477 if (n == 0) return
478
479 ! initializing in y-direction
480 is2_muscl%beg = -buff_size; is2_muscl%end = n - is2_muscl%beg
481 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
482
483 if (p == 0) then
484 is3_muscl%beg = 0
485 else
486 is3_muscl%beg = -buff_size
487 end if
488
489 is3_muscl%end = p - is3_muscl%beg
490
491 if (p == 0) return
492
493 ! initializing in z-direction
494 is2_muscl%beg = -buff_size; is2_muscl%end = n - is2_muscl%beg
495 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
496 is3_muscl%beg = -buff_size; is3_muscl%end = p - is3_muscl%beg
497
498 end subroutine s_initialize_muscl_module
499
500 !> Perform MUSCL reconstruction of left and right cell-boundary values from cell-averaged variables
501 subroutine s_muscl(v_vf, vL_rs_vf_x, vR_rs_vf_x, muscl_dir, is1_muscl_d, is2_muscl_d, is3_muscl_d)
502
503 type(scalar_field), dimension(1:), intent(in) :: v_vf
504 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x, vr_rs_vf_x
505 integer, intent(in) :: muscl_dir
506 type(int_bounds_info), intent(in) :: is1_muscl_d, is2_muscl_d, is3_muscl_d
507 integer :: j, k, l, i
508 real(wp) :: slopel, sloper, slope
509
510 is1_muscl = is1_muscl_d
511 is2_muscl = is2_muscl_d
512 is3_muscl = is3_muscl_d
513
514
515# 100 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
516#if defined(MFC_OpenACC)
517# 100 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
518!$acc update device(is1_muscl, is2_muscl, is3_muscl)
519# 100 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
520#elif defined(MFC_OpenMP)
521# 100 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
522!$omp target update to(is1_muscl, is2_muscl, is3_muscl)
523# 100 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
524#endif
525# 101 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
526
527 if (muscl_order == muscl_order_first_order) then
528 if (muscl_dir == 1) then
529
530# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
531
532# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
533#if defined(MFC_OpenACC)
534# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
535!$acc parallel loop collapse(4) gang vector default(present)
536# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
537#elif defined(MFC_OpenMP)
538# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
539
540# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
541
542# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
543
544# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
545!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
546# 104 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
547#endif
548# 105 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
549 do i = 1, ubound(v_vf, 1)
550 do l = is3_muscl%beg, is3_muscl%end
551 do k = is2_muscl%beg, is2_muscl%end
552 do j = is1_muscl%beg, is1_muscl%end
553 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
554 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
555 end do
556 end do
557 end do
558 end do
559
560# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
561#if defined(MFC_OpenACC)
562# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
563!$acc end parallel loop
564# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
565#elif defined(MFC_OpenMP)
566# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
567
568# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
569!$omp end target teams loop
570# 115 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
571#endif
572# 116 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
573 else if (muscl_dir == 2) then
574
575# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
576
577# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
578#if defined(MFC_OpenACC)
579# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
580!$acc parallel loop collapse(4) gang vector default(present)
581# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
582#elif defined(MFC_OpenMP)
583# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
584
585# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
586
587# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
588
589# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
590!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
591# 117 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
592#endif
593# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
594 do i = 1, ubound(v_vf, 1)
595 do l = is3_muscl%beg, is3_muscl%end
596 do j = is1_muscl%beg, is1_muscl%end
597 do k = is2_muscl%beg, is2_muscl%end
598 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
599 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
600 end do
601 end do
602 end do
603 end do
604
605# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
606#if defined(MFC_OpenACC)
607# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
608!$acc end parallel loop
609# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
610#elif defined(MFC_OpenMP)
611# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
612
613# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
614!$omp end target teams loop
615# 128 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
616#endif
617# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
618 else if (muscl_dir == 3) then
619
620# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
621
622# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
623#if defined(MFC_OpenACC)
624# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
625!$acc parallel loop collapse(4) gang vector default(present)
626# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
627#elif defined(MFC_OpenMP)
628# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
629
630# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
631
632# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
633
634# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
635!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
636# 130 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
637#endif
638# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
639 do i = 1, ubound(v_vf, 1)
640 do j = is1_muscl%beg, is1_muscl%end
641 do k = is2_muscl%beg, is2_muscl%end
642 do l = is3_muscl%beg, is3_muscl%end
643 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
644 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
645 end do
646 end do
647 end do
648 end do
649
650# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
651#if defined(MFC_OpenACC)
652# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
653!$acc end parallel loop
654# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
655#elif defined(MFC_OpenMP)
656# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
657
658# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
659!$omp end target teams loop
660# 141 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
661#endif
662# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
663 end if
664 end if
665
666 v_size = ubound(v_vf, 1)
667
668# 146 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
669#if defined(MFC_OpenACC)
670# 146 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
671!$acc update device(v_size)
672# 146 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
673#elif defined(MFC_OpenMP)
674# 146 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
675!$omp target update to(v_size)
676# 146 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
677#endif
678# 147 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
679
680 if (muscl_order /= muscl_order_first_order) then
681
682# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
683
684# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
685#if defined(MFC_OpenACC)
686# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
687!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, i)
688# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
689#elif defined(MFC_OpenMP)
690# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
691
692# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
693
694# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
695
696# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
697!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l, i)
698# 149 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
699#endif
700# 150 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
701 do i = 1, v_size
702 do l = idwbuff(3)%beg, idwbuff(3)%end
703 do k = idwbuff(2)%beg, idwbuff(2)%end
704 do j = idwbuff(1)%beg, idwbuff(1)%end
705 v_rs_ws_muscl(j, k, l, i) = v_vf(i)%sf(j, k, l)
706 end do
707 end do
708 end do
709 end do
710
711# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
712#if defined(MFC_OpenACC)
713# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
714!$acc end parallel loop
715# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
716#elif defined(MFC_OpenMP)
717# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
718
719# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
720!$omp end target teams loop
721# 159 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
722#endif
723# 160 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
724 end if
725
726 if (muscl_order == muscl_order_second_order) then
727 ! MUSCL Reconstruction
728# 168 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
729# 169 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
730# 170 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
731 if (muscl_dir == 1) then
732# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
733
734# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
735
736# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
737#if defined(MFC_OpenACC)
738# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
739!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
740# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
741#elif defined(MFC_OpenMP)
742# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
743
744# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
745
746# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
747
748# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
749!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
750# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
751!$omp& private(i, j, k, l, slopeL, slopeR, slope)
752# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
753#endif
754# 172 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
755 do l = is3_muscl%beg, is3_muscl%end
756# 173 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
757 do k = is2_muscl%beg, is2_muscl%end
758# 174 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
759 do j = is1_muscl%beg, is1_muscl%end
760# 175 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
761 do i = 1, v_size
762 slopel = v_rs_ws_muscl(j + 1, k, l, i) - v_rs_ws_muscl(j, k, l, i)
763# 177 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
764 sloper = v_rs_ws_muscl(j, k, l, i) - v_rs_ws_muscl(j - 1, k, l, i)
765# 178 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
766 slope = 0._wp
767
768 if (muscl_lim == muscl_lim_unlimited) then ! unlimited (central difference)
769 slope = 5e-1_wp*(slopel + sloper)
770 else if (muscl_lim == muscl_lim_minmod) then ! minmod
771 if (slopel*sloper > muscl_eps) then
772 slope = min(abs(slopel), abs(sloper))
773 end if
774 if (slopel < 0._wp) slope = -slope
775 else if (muscl_lim == muscl_lim_mc) then ! MC
776 if (slopel*sloper > muscl_eps) then
777 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
778 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
779 end if
780 if (slopel < 0._wp) slope = -slope
781 else if (muscl_lim == muscl_lim_van_albada) then ! Van Albada
782 if (slopel*sloper > muscl_eps) then
783 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
784 end if
785 else if (muscl_lim == muscl_lim_van_leer) then ! Van Leer
786 if (slopel*sloper > muscl_eps) then
787 slope = 2._wp*slopel*sloper/(slopel + sloper)
788 end if
789 else if (muscl_lim == muscl_lim_superbee) then ! SUPERBEE
790 if (slopel*sloper > muscl_eps) then
791 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
792 & 2._wp*abs(sloper)))
793 end if
794 if (slopel < 0._wp) slope = -slope
795 end if
796
797 ! reconstruct from left side
798 vl_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) - (5.e-1_wp*slope)
799# 211 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
800
801 ! reconstruct from the right side
802 vr_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) + (5.e-1_wp*slope)
803# 214 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
804 end do
805 end do
806 end do
807 end do
808
809# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
810#if defined(MFC_OpenACC)
811# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
812!$acc end parallel loop
813# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
814#elif defined(MFC_OpenMP)
815# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
816
817# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
818!$omp end target teams loop
819# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
820#endif
821# 219 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
822 end if
823# 168 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
824# 169 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
825# 170 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
826 if (muscl_dir == 2) then
827# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
828
829# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
830
831# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
832#if defined(MFC_OpenACC)
833# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
834!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
835# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
836#elif defined(MFC_OpenMP)
837# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
838
839# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
840
841# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
842
843# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
844!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
845# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
846!$omp& private(i, j, k, l, slopeL, slopeR, slope)
847# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
848#endif
849# 172 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
850 do l = is3_muscl%beg, is3_muscl%end
851# 173 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
852 do k = is1_muscl%beg, is1_muscl%end
853# 174 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
854 do j = is2_muscl%beg, is2_muscl%end
855# 175 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
856 do i = 1, v_size
857 slopel = v_rs_ws_muscl(j, k + 1, l, i) - v_rs_ws_muscl(j, k, l, i)
858# 177 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
859 sloper = v_rs_ws_muscl(j, k, l, i) - v_rs_ws_muscl(j, k - 1, l, i)
860# 178 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
861 slope = 0._wp
862
863 if (muscl_lim == muscl_lim_unlimited) then ! unlimited (central difference)
864 slope = 5e-1_wp*(slopel + sloper)
865 else if (muscl_lim == muscl_lim_minmod) then ! minmod
866 if (slopel*sloper > muscl_eps) then
867 slope = min(abs(slopel), abs(sloper))
868 end if
869 if (slopel < 0._wp) slope = -slope
870 else if (muscl_lim == muscl_lim_mc) then ! MC
871 if (slopel*sloper > muscl_eps) then
872 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
873 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
874 end if
875 if (slopel < 0._wp) slope = -slope
876 else if (muscl_lim == muscl_lim_van_albada) then ! Van Albada
877 if (slopel*sloper > muscl_eps) then
878 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
879 end if
880 else if (muscl_lim == muscl_lim_van_leer) then ! Van Leer
881 if (slopel*sloper > muscl_eps) then
882 slope = 2._wp*slopel*sloper/(slopel + sloper)
883 end if
884 else if (muscl_lim == muscl_lim_superbee) then ! SUPERBEE
885 if (slopel*sloper > muscl_eps) then
886 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
887 & 2._wp*abs(sloper)))
888 end if
889 if (slopel < 0._wp) slope = -slope
890 end if
891
892 ! reconstruct from left side
893 vl_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) - (5.e-1_wp*slope)
894# 211 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
895
896 ! reconstruct from the right side
897 vr_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) + (5.e-1_wp*slope)
898# 214 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
899 end do
900 end do
901 end do
902 end do
903
904# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
905#if defined(MFC_OpenACC)
906# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
907!$acc end parallel loop
908# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
909#elif defined(MFC_OpenMP)
910# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
911
912# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
913!$omp end target teams loop
914# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
915#endif
916# 219 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
917 end if
918# 168 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
919# 169 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
920# 170 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
921 if (muscl_dir == 3) then
922# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
923
924# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
925
926# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
927#if defined(MFC_OpenACC)
928# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
929!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
930# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
931#elif defined(MFC_OpenMP)
932# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
933
934# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
935
936# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
937
938# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
939!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
940# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
941!$omp& private(i, j, k, l, slopeL, slopeR, slope)
942# 171 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
943#endif
944# 172 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
945 do l = is1_muscl%beg, is1_muscl%end
946# 173 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
947 do k = is2_muscl%beg, is2_muscl%end
948# 174 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
949 do j = is3_muscl%beg, is3_muscl%end
950# 175 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
951 do i = 1, v_size
952 slopel = v_rs_ws_muscl(j, k, l + 1, i) - v_rs_ws_muscl(j, k, l, i)
953# 177 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
954 sloper = v_rs_ws_muscl(j, k, l, i) - v_rs_ws_muscl(j, k, l - 1, i)
955# 178 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
956 slope = 0._wp
957
958 if (muscl_lim == muscl_lim_unlimited) then ! unlimited (central difference)
959 slope = 5e-1_wp*(slopel + sloper)
960 else if (muscl_lim == muscl_lim_minmod) then ! minmod
961 if (slopel*sloper > muscl_eps) then
962 slope = min(abs(slopel), abs(sloper))
963 end if
964 if (slopel < 0._wp) slope = -slope
965 else if (muscl_lim == muscl_lim_mc) then ! MC
966 if (slopel*sloper > muscl_eps) then
967 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
968 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
969 end if
970 if (slopel < 0._wp) slope = -slope
971 else if (muscl_lim == muscl_lim_van_albada) then ! Van Albada
972 if (slopel*sloper > muscl_eps) then
973 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
974 end if
975 else if (muscl_lim == muscl_lim_van_leer) then ! Van Leer
976 if (slopel*sloper > muscl_eps) then
977 slope = 2._wp*slopel*sloper/(slopel + sloper)
978 end if
979 else if (muscl_lim == muscl_lim_superbee) then ! SUPERBEE
980 if (slopel*sloper > muscl_eps) then
981 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
982 & 2._wp*abs(sloper)))
983 end if
984 if (slopel < 0._wp) slope = -slope
985 end if
986
987 ! reconstruct from left side
988 vl_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) - (5.e-1_wp*slope)
989# 211 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
990
991 ! reconstruct from the right side
992 vr_rs_vf_x(j, k, l, i) = v_rs_ws_muscl(j, k, l, i) + (5.e-1_wp*slope)
993# 214 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
994 end do
995 end do
996 end do
997 end do
998
999# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1000#if defined(MFC_OpenACC)
1001# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1002!$acc end parallel loop
1003# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1004#elif defined(MFC_OpenMP)
1005# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1006
1007# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1008!$omp end target teams loop
1009# 218 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1010#endif
1011# 219 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1012 end if
1013# 221 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1014 end if
1015
1016 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
1017 call nvtxstartrange("WENO-INTCOMP")
1018# 226 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1019 if (muscl_dir == 1) then
1020# 227 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1021 call s_thinc_compression(v_rs_ws_muscl, vl_rs_vf_x, vr_rs_vf_x, muscl_dir, is1_muscl, is2_muscl, is3_muscl)
1022 end if
1023# 226 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1024 if (muscl_dir == 2) then
1025# 227 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1026 call s_thinc_compression(v_rs_ws_muscl, vl_rs_vf_x, vr_rs_vf_x, muscl_dir, is1_muscl, is2_muscl, is3_muscl)
1027 end if
1028# 226 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1029 if (muscl_dir == 3) then
1030# 227 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1031 call s_thinc_compression(v_rs_ws_muscl, vl_rs_vf_x, vr_rs_vf_x, muscl_dir, is1_muscl, is2_muscl, is3_muscl)
1032 end if
1033# 230 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1034 call nvtxendrange()
1035 end if
1036
1037 end subroutine s_muscl
1038
1039 !> Finalize the MUSCL module
1040 subroutine s_finalize_muscl_module()
1041
1042#ifdef MFC_DEBUG
1043# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1044 block
1045# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1046 use iso_fortran_env, only: output_unit
1047# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1048
1049# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1050 print *, 'm_muscl.fpp:238: ', '@:DEALLOCATE(v_rs_ws_muscl)'
1051# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1052
1053# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1054 call flush (output_unit)
1055# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1056 end block
1057# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1058#endif
1059# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1060
1061# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1062#if defined(MFC_OpenACC)
1063# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1064!$acc exit data delete(v_rs_ws_muscl)
1065# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1066#elif defined(MFC_OpenMP)
1067# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1068!$omp target exit data map(release:v_rs_ws_muscl)
1069# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1070#endif
1071# 238 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1072 deallocate (v_rs_ws_muscl)
1073# 239 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1074
1075 end subroutine s_finalize_muscl_module
1076
1077end module m_muscl
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1049
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1049
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1049
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::muscl_lim_van_albada
integer, parameter muscl_lim_van_albada
Definition m_constants.fpp.f90:160
m_constants::muscl_lim_van_leer
integer, parameter muscl_lim_van_leer
Definition m_constants.fpp.f90:161
m_constants::muscl_lim_mc
integer, parameter muscl_lim_mc
Definition m_constants.fpp.f90:159
m_constants::muscl_order_second_order
integer, parameter muscl_order_second_order
Definition m_constants.fpp.f90:164
m_constants::muscl_order_first_order
integer, parameter muscl_order_first_order
Definition m_constants.fpp.f90:163
m_constants::muscl_lim_unlimited
integer, parameter muscl_lim_unlimited
Definition m_constants.fpp.f90:157
m_constants::muscl_lim_superbee
integer, parameter muscl_lim_superbee
Definition m_constants.fpp.f90:162
m_constants::muscl_lim_minmod
integer, parameter muscl_lim_minmod
Definition m_constants.fpp.f90:158
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:853
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:367
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:367
m_muscl
MUSCL reconstruction with interface sharpening for contact-preserving advection.
Definition m_muscl.fpp.f90:356
m_muscl::v_rs_ws_muscl
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_muscl
Definition m_muscl.fpp.f90:404
m_muscl::is2_muscl
type(int_bounds_info) is2_muscl
Definition m_muscl.fpp.f90:388
m_muscl::is3_muscl
type(int_bounds_info) is3_muscl
Definition m_muscl.fpp.f90:388
m_muscl::s_muscl
subroutine, public s_muscl(v_vf, vl_rs_vf_x, vr_rs_vf_x, muscl_dir, is1_muscl_d, is2_muscl_d, is3_muscl_d)
Perform MUSCL reconstruction of left and right cell-boundary values from cell-averaged variables.
Definition m_muscl.fpp.f90:502
m_muscl::is1_muscl
type(int_bounds_info) is1_muscl
Definition m_muscl.fpp.f90:388
m_muscl::s_initialize_muscl_module
subroutine, public s_initialize_muscl_module()
Allocate and initialize MUSCL reconstruction working arrays.
Definition m_muscl.fpp.f90:423
m_muscl::v_size
integer v_size
Definition m_muscl.fpp.f90:374
m_muscl::s_finalize_muscl_module
subroutine, public s_finalize_muscl_module()
Finalize the MUSCL module.
Definition m_muscl.fpp.f90:1041
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_thinc
THINC and MTHINC interface compression for volume fraction sharpening. THINC (int_comp=1): 1D directi...
Definition m_thinc.fpp.f90:362
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:450