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# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226! GPU parallel region (scalar reductions, maxval/minval)
227# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
228
229! GPU parallel loop over threads (most common GPU macro)
230# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232! Required closing for GPU_PARALLEL_LOOP
233# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! Mark routine for device compilation
236# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Declare device-resident data
239# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Inner loop within a GPU parallel region
242# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Scoped GPU data region
245# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Host code with device pointers (for MPI with GPU buffers)
248# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Allocate device memory (unscoped)
251# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Free device memory
254# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Atomic operation on device
257# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! End atomic capture block
260# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Copy data between host and device
263# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Synchronization barrier
266# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Import GPU library module (openacc or omp_lib)
269# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Emit code only for AMD compiler
272# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Emit code for non-Cray compilers
275# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for Cray compiler
278# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-NVIDIA compilers
281# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
284# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285! New line at end of file is required for FYPP
286# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
287
288# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
291! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
292! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
293# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295! Allocate and create GPU device memory
296# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298! Free GPU device memory and deallocate
299# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Cray-specific GPU pointer setup for vector fields
302# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Cray-specific GPU pointer setup for scalar fields
305# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for acoustic source spatials
308# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
311
312# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313! New line at end of file is required for FYPP
314# 6 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp" 2
315
316!> @brief MUSCL reconstruction with interface sharpening for contact-preserving advection
317module m_muscl
318
319 use m_derived_types
320 use m_global_parameters
321 use m_variables_conversion
322#ifdef MFC_OpenACC
323 use openacc
324#endif
325
326 use m_mpi_proxy
327 use m_helper
328
329 private; public :: s_initialize_muscl_module, s_muscl, s_finalize_muscl_module, s_interface_compression
330
331 integer :: v_size
332
333# 23 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
334#if defined(MFC_OpenACC)
335# 23 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
336!$acc declare create(v_size)
337# 23 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
338#elif defined(MFC_OpenMP)
339# 23 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
340!$omp declare target (v_size)
341# 23 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
342#endif
343
344 type(int_bounds_info) :: is1_muscl, is2_muscl, is3_muscl
345
346# 26 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
347#if defined(MFC_OpenACC)
348# 26 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
349!$acc declare create(is1_muscl, is2_muscl, is3_muscl)
350# 26 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
351#elif defined(MFC_OpenMP)
352# 26 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
353!$omp declare target (is1_muscl, is2_muscl, is3_muscl)
354# 26 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
355#endif
356
357 !> @name The cell-average variables that will be MUSCL-reconstructed. Formerly, they are stored in v_vf. However, they are
358 !! transferred to v_rs_wsL and v_rs_wsR as to be reshaped (RS) and/or characteristically decomposed. The reshaping allows the
359 !! muscl procedure to be independent of the coordinate direction of the reconstruction. Lastly, notice that the left (L) and
360 !! right (R) results of the characteristic decomposition are stored in custom-constructed muscl- stencils (WS) that are annexed
361 !! to each position of a given scalar field.
362 !> @{
363 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_ws_x_muscl, v_rs_ws_y_muscl, v_rs_ws_z_muscl
364 !> @}
365
366# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
367#if defined(MFC_OpenACC)
368# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
369!$acc declare create(v_rs_ws_x_muscl, v_rs_ws_y_muscl, v_rs_ws_z_muscl)
370# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
371#elif defined(MFC_OpenMP)
372# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
373!$omp declare target (v_rs_ws_x_muscl, v_rs_ws_y_muscl, v_rs_ws_z_muscl)
374# 36 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
375#endif
376
377contains
378
379 !> Allocate and initialize MUSCL reconstruction working arrays
380 subroutine s_initialize_muscl_module()
381
382 ! Initializing in x-direction
383 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
384 if (n == 0) then
385 is2_muscl%beg = 0
386 else
387 is2_muscl%beg = -buff_size
388 end if
389
390 is2_muscl%end = n - is2_muscl%beg
391
392 if (p == 0) then
393 is3_muscl%beg = 0
394 else
395 is3_muscl%beg = -buff_size
396 end if
397
398 is3_muscl%end = p - is3_muscl%beg
399
400#ifdef MFC_DEBUG
401# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
402 block
403# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
404 use iso_fortran_env, only: output_unit
405# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
406
407# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
408 print *, 'm_muscl.fpp:61: ', '@:ALLOCATE(v_rs_ws_x_muscl(is1_muscl%beg:is1_muscl%end, is2_muscl%beg:is2_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))'
409# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
410
411# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
412 call flush (output_unit)
413# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
414 end block
415# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
416#endif
417# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
418 allocate (v_rs_ws_x_muscl(is1_muscl%beg:is1_muscl%end, is2_muscl%beg:is2_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))
419# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
420
421# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
422
423# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
424#if defined(MFC_OpenACC)
425# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
426!$acc enter data create(v_rs_ws_x_muscl)
427# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
428#elif defined(MFC_OpenMP)
429# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
430!$omp target enter data map(always,alloc:v_rs_ws_x_muscl)
431# 61 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
432#endif
433# 63 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
434
435 if (n == 0) return
436
437 ! initializing in y-direction
438 is2_muscl%beg = -buff_size; is2_muscl%end = n - is2_muscl%beg
439 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
440
441 if (p == 0) then
442 is3_muscl%beg = 0
443 else
444 is3_muscl%beg = -buff_size
445 end if
446
447 is3_muscl%end = p - is3_muscl%beg
448
449#ifdef MFC_DEBUG
450# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
451 block
452# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
453 use iso_fortran_env, only: output_unit
454# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
455
456# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
457 print *, 'm_muscl.fpp:78: ', '@:ALLOCATE(v_rs_ws_y_muscl(is2_muscl%beg:is2_muscl%end, is1_muscl%beg:is1_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))'
458# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
459
460# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
461 call flush (output_unit)
462# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
463 end block
464# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
465#endif
466# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
467 allocate (v_rs_ws_y_muscl(is2_muscl%beg:is2_muscl%end, is1_muscl%beg:is1_muscl%end, is3_muscl%beg:is3_muscl%end, 1:sys_size))
468# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
469
470# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
471
472# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
473#if defined(MFC_OpenACC)
474# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
475!$acc enter data create(v_rs_ws_y_muscl)
476# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
477#elif defined(MFC_OpenMP)
478# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
479!$omp target enter data map(always,alloc:v_rs_ws_y_muscl)
480# 78 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
481#endif
482# 80 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
483
484 if (p == 0) return
485
486 ! initializing in z-direction
487 is2_muscl%beg = -buff_size; is2_muscl%end = n - is2_muscl%beg
488 is1_muscl%beg = -buff_size; is1_muscl%end = m - is1_muscl%beg
489 is3_muscl%beg = -buff_size; is3_muscl%end = p - is3_muscl%beg
490
491#ifdef MFC_DEBUG
492# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
493 block
494# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
495 use iso_fortran_env, only: output_unit
496# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
497
498# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
499 print *, 'm_muscl.fpp:88: ', '@:ALLOCATE(v_rs_ws_z_muscl(is3_muscl%beg:is3_muscl%end, is2_muscl%beg:is2_muscl%end, is1_muscl%beg:is1_muscl%end, 1:sys_size))'
500# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
501
502# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
503 call flush (output_unit)
504# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
505 end block
506# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
507#endif
508# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
509 allocate (v_rs_ws_z_muscl(is3_muscl%beg:is3_muscl%end, is2_muscl%beg:is2_muscl%end, is1_muscl%beg:is1_muscl%end, 1:sys_size))
510# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
511
512# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
513
514# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
515#if defined(MFC_OpenACC)
516# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
517!$acc enter data create(v_rs_ws_z_muscl)
518# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
519#elif defined(MFC_OpenMP)
520# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
521!$omp target enter data map(always,alloc:v_rs_ws_z_muscl)
522# 88 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
523#endif
524# 90 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
525
526 end subroutine s_initialize_muscl_module
527
528 !> Perform MUSCL reconstruction of left and right cell-boundary values from cell-averaged variables
529 subroutine s_muscl(v_vf, vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z, vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z, muscl_dir, is1_muscl_d, &
530
531 & is2_muscl_d, is3_muscl_d)
532
533 type(scalar_field), dimension(1:), intent(in) :: v_vf
534 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x, vl_rs_vf_y, &
535 & vL_rs_vf_z, vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z
536 integer, intent(in) :: muscl_dir
537 type(int_bounds_info), intent(in) :: is1_muscl_d, is2_muscl_d, is3_muscl_d
538 integer :: j, k, l, i
539 real(wp) :: slopel, sloper, slope
540
541 is1_muscl = is1_muscl_d
542 is2_muscl = is2_muscl_d
543 is3_muscl = is3_muscl_d
544
545
546# 110 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
547#if defined(MFC_OpenACC)
548# 110 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
549!$acc update device(is1_muscl, is2_muscl, is3_muscl)
550# 110 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
551#elif defined(MFC_OpenMP)
552# 110 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
553!$omp target update to(is1_muscl, is2_muscl, is3_muscl)
554# 110 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
555#endif
556
557 if (muscl_order /= 1 .or. dummy) then
558 call s_initialize_muscl(v_vf, muscl_dir)
559 end if
560
561 if (muscl_order == 1 .or. dummy) then
562 if (muscl_dir == 1) then
563
564# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
565
566# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
567#if defined(MFC_OpenACC)
568# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
569!$acc parallel loop collapse(4) gang vector default(present)
570# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
571#elif defined(MFC_OpenMP)
572# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
573
574# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
575
576# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
577
578# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
579!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
580# 118 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
581#endif
582 do i = 1, ubound(v_vf, 1)
583 do l = is3_muscl%beg, is3_muscl%end
584 do k = is2_muscl%beg, is2_muscl%end
585 do j = is1_muscl%beg, is1_muscl%end
586 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
587 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
588 end do
589 end do
590 end do
591 end do
592
593# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
594#if defined(MFC_OpenACC)
595# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
596!$acc end parallel loop
597# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
598#elif defined(MFC_OpenMP)
599# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
600
601# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
602!$omp end target teams loop
603# 129 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
604#endif
605 else if (muscl_dir == 2) then
606
607# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
608
609# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
610#if defined(MFC_OpenACC)
611# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
612!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l)
613# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
614#elif defined(MFC_OpenMP)
615# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
616
617# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
618
619# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
620
621# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
622!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l)
623# 131 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
624#endif
625 do i = 1, ubound(v_vf, 1)
626 do l = is3_muscl%beg, is3_muscl%end
627 do k = is2_muscl%beg, is2_muscl%end
628 do j = is1_muscl%beg, is1_muscl%end
629 vl_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
630 vr_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
631 end do
632 end do
633 end do
634 end do
635
636# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
637#if defined(MFC_OpenACC)
638# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
639!$acc end parallel loop
640# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
641#elif defined(MFC_OpenMP)
642# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
643
644# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
645!$omp end target teams loop
646# 142 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
647#endif
648 else if (muscl_dir == 3) then
649
650# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
651
652# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
653#if defined(MFC_OpenACC)
654# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
655!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l)
656# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
657#elif defined(MFC_OpenMP)
658# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
659
660# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
661
662# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
663
664# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
665!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l)
666# 144 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
667#endif
668 do i = 1, ubound(v_vf, 1)
669 do l = is3_muscl%beg, is3_muscl%end
670 do k = is2_muscl%beg, is2_muscl%end
671 do j = is1_muscl%beg, is1_muscl%end
672 vl_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
673 vr_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
674 end do
675 end do
676 end do
677 end do
678
679# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
680#if defined(MFC_OpenACC)
681# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
682!$acc end parallel loop
683# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
684#elif defined(MFC_OpenMP)
685# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
686
687# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
688!$omp end target teams loop
689# 155 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
690#endif
691 end if
692 end if
693
694 if (muscl_order == 2 .or. dummy) then
695 ! MUSCL Reconstruction
696# 162 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
697 if (muscl_dir == 1) then
698
699# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
700
701# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
702#if defined(MFC_OpenACC)
703# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
704!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
705# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
706#elif defined(MFC_OpenMP)
707# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
708
709# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
710
711# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
712
713# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
714!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, slopeL, slopeR, slope)
715# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
716#endif
717 do l = is3_muscl%beg, is3_muscl%end
718 do k = is2_muscl%beg, is2_muscl%end
719 do j = is1_muscl%beg, is1_muscl%end
720 do i = 1, v_size
721 slopel = v_rs_ws_x_muscl(j + 1, k, l, i) - v_rs_ws_x_muscl(j, k, l, i)
722 sloper = v_rs_ws_x_muscl(j, k, l, i) - v_rs_ws_x_muscl(j - 1, k, l, i)
723 slope = 0._wp
724
725 if (muscl_lim == 1) then ! minmod
726 if (slopel*sloper > 1e-9_wp) then
727 slope = min(abs(slopel), abs(sloper))
728 end if
729 if (slopel < 0._wp) slope = -slope
730 else if (muscl_lim == 2) then ! MC
731 if (slopel*sloper > 1e-9_wp) then
732 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
733 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
734 end if
735 if (slopel < 0._wp) slope = -slope
736 else if (muscl_lim == 3) then ! Van Albada
737 if (abs(slopel) > 1e-6_wp .and. abs(sloper) > 1e-6_wp .and. abs(slopel + sloper) &
738 & > 1e-6_wp .and. slopel*sloper > 1e-6_wp) then
739 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
740 end if
741 else if (muscl_lim == 4) then ! Van Leer
742 if (abs(slopel + sloper) > 1.e-6_wp .and. slopel*sloper > 1.e-6_wp) then
743 slope = 2._wp*slopel*sloper/(slopel + sloper)
744 end if
745 else if (muscl_lim == 5) then ! SUPERBEE
746 if (slopel*sloper > 1e-6_wp) then
747 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
748 & 2._wp*abs(sloper)))
749 end if
750 end if
751
752 ! reconstruct from left side
753 vl_rs_vf_x(j, k, l, i) = v_rs_ws_x_muscl(j, k, l, i) - (5.e-1_wp*slope)
754
755 ! reconstruct from the right side
756 vr_rs_vf_x(j, k, l, i) = v_rs_ws_x_muscl(j, k, l, i) + (5.e-1_wp*slope)
757 end do
758 end do
759 end do
760 end do
761
762# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
763#if defined(MFC_OpenACC)
764# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
765!$acc end parallel loop
766# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
767#elif defined(MFC_OpenMP)
768# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
769
770# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
771!$omp end target teams loop
772# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
773#endif
774 end if
775# 162 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
776 if (muscl_dir == 2) then
777
778# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
779
780# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
781#if defined(MFC_OpenACC)
782# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
783!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
784# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
785#elif defined(MFC_OpenMP)
786# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
787
788# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
789
790# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
791
792# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
793!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, slopeL, slopeR, slope)
794# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
795#endif
796 do l = is3_muscl%beg, is3_muscl%end
797 do k = is2_muscl%beg, is2_muscl%end
798 do j = is1_muscl%beg, is1_muscl%end
799 do i = 1, v_size
800 slopel = v_rs_ws_y_muscl(j + 1, k, l, i) - v_rs_ws_y_muscl(j, k, l, i)
801 sloper = v_rs_ws_y_muscl(j, k, l, i) - v_rs_ws_y_muscl(j - 1, k, l, i)
802 slope = 0._wp
803
804 if (muscl_lim == 1) then ! minmod
805 if (slopel*sloper > 1e-9_wp) then
806 slope = min(abs(slopel), abs(sloper))
807 end if
808 if (slopel < 0._wp) slope = -slope
809 else if (muscl_lim == 2) then ! MC
810 if (slopel*sloper > 1e-9_wp) then
811 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
812 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
813 end if
814 if (slopel < 0._wp) slope = -slope
815 else if (muscl_lim == 3) then ! Van Albada
816 if (abs(slopel) > 1e-6_wp .and. abs(sloper) > 1e-6_wp .and. abs(slopel + sloper) &
817 & > 1e-6_wp .and. slopel*sloper > 1e-6_wp) then
818 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
819 end if
820 else if (muscl_lim == 4) then ! Van Leer
821 if (abs(slopel + sloper) > 1.e-6_wp .and. slopel*sloper > 1.e-6_wp) then
822 slope = 2._wp*slopel*sloper/(slopel + sloper)
823 end if
824 else if (muscl_lim == 5) then ! SUPERBEE
825 if (slopel*sloper > 1e-6_wp) then
826 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
827 & 2._wp*abs(sloper)))
828 end if
829 end if
830
831 ! reconstruct from left side
832 vl_rs_vf_y(j, k, l, i) = v_rs_ws_y_muscl(j, k, l, i) - (5.e-1_wp*slope)
833
834 ! reconstruct from the right side
835 vr_rs_vf_y(j, k, l, i) = v_rs_ws_y_muscl(j, k, l, i) + (5.e-1_wp*slope)
836 end do
837 end do
838 end do
839 end do
840
841# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
842#if defined(MFC_OpenACC)
843# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
844!$acc end parallel loop
845# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
846#elif defined(MFC_OpenMP)
847# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
848
849# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
850!$omp end target teams loop
851# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
852#endif
853 end if
854# 162 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
855 if (muscl_dir == 3) then
856
857# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
858
859# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
860#if defined(MFC_OpenACC)
861# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
862!$acc parallel loop collapse(4) gang vector default(present) private(i, j, k, l, slopeL, slopeR, slope)
863# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
864#elif defined(MFC_OpenMP)
865# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
866
867# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
868
869# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
870
871# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
872!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, slopeL, slopeR, slope)
873# 163 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
874#endif
875 do l = is3_muscl%beg, is3_muscl%end
876 do k = is2_muscl%beg, is2_muscl%end
877 do j = is1_muscl%beg, is1_muscl%end
878 do i = 1, v_size
879 slopel = v_rs_ws_z_muscl(j + 1, k, l, i) - v_rs_ws_z_muscl(j, k, l, i)
880 sloper = v_rs_ws_z_muscl(j, k, l, i) - v_rs_ws_z_muscl(j - 1, k, l, i)
881 slope = 0._wp
882
883 if (muscl_lim == 1) then ! minmod
884 if (slopel*sloper > 1e-9_wp) then
885 slope = min(abs(slopel), abs(sloper))
886 end if
887 if (slopel < 0._wp) slope = -slope
888 else if (muscl_lim == 2) then ! MC
889 if (slopel*sloper > 1e-9_wp) then
890 slope = min(2._wp*abs(slopel), 2._wp*abs(sloper))
891 slope = min(slope, 5e-1_wp*(abs(slopel) + abs(sloper)))
892 end if
893 if (slopel < 0._wp) slope = -slope
894 else if (muscl_lim == 3) then ! Van Albada
895 if (abs(slopel) > 1e-6_wp .and. abs(sloper) > 1e-6_wp .and. abs(slopel + sloper) &
896 & > 1e-6_wp .and. slopel*sloper > 1e-6_wp) then
897 slope = ((slopel + sloper)*slopel*sloper)/(slopel**2._wp + sloper**2._wp)
898 end if
899 else if (muscl_lim == 4) then ! Van Leer
900 if (abs(slopel + sloper) > 1.e-6_wp .and. slopel*sloper > 1.e-6_wp) then
901 slope = 2._wp*slopel*sloper/(slopel + sloper)
902 end if
903 else if (muscl_lim == 5) then ! SUPERBEE
904 if (slopel*sloper > 1e-6_wp) then
905 slope = -1._wp*min(-min(2._wp*abs(slopel), abs(sloper)), -min(abs(slopel), &
906 & 2._wp*abs(sloper)))
907 end if
908 end if
909
910 ! reconstruct from left side
911 vl_rs_vf_z(j, k, l, i) = v_rs_ws_z_muscl(j, k, l, i) - (5.e-1_wp*slope)
912
913 ! reconstruct from the right side
914 vr_rs_vf_z(j, k, l, i) = v_rs_ws_z_muscl(j, k, l, i) + (5.e-1_wp*slope)
915 end do
916 end do
917 end do
918 end do
919
920# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
921#if defined(MFC_OpenACC)
922# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
923!$acc end parallel loop
924# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
925#elif defined(MFC_OpenMP)
926# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
927
928# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
929!$omp end target teams loop
930# 208 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
931#endif
932 end if
933# 211 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
934 end if
935
936 if (int_comp) then
937 call s_interface_compression(vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, muscl_dir, &
938 & is1_muscl_d, is2_muscl_d, is3_muscl_d)
939 end if
940
941 end subroutine s_muscl
942
943 !> Apply THINC interface-compression to sharpen volume-fraction reconstructions at material interfaces
944 subroutine s_interface_compression(vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z, vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z, muscl_dir, &
945
946 & is1_muscl_d, is2_muscl_d, is3_muscl_d)
947
948 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x, vl_rs_vf_y, &
949 & vL_rs_vf_z, vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z
950 integer, intent(in) :: muscl_dir
951 type(int_bounds_info), intent(in) :: is1_muscl_d, is2_muscl_d, is3_muscl_d
952 integer :: j, k, l
953 real(wp) :: acl, acr, ac, athinc, qmin, qmax, a, b, c, sign, moncon
954
955# 233 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
956 if (muscl_dir == 1) then
957
958# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
959
960# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
961#if defined(MFC_OpenACC)
962# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
963!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
964# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
965#elif defined(MFC_OpenMP)
966# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
967
968# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
969
970# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
971
972# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
973!$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, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
974# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
975#endif
976 do l = is3_muscl%beg, is3_muscl%end
977 do k = is2_muscl%beg, is2_muscl%end
978 do j = is1_muscl%beg, is1_muscl%end
979 acl = v_rs_ws_x_muscl(j - 1, k, l, eqn_idx%adv%beg)
980 ac = v_rs_ws_x_muscl(j, k, l, eqn_idx%adv%beg)
981 acr = v_rs_ws_x_muscl(j + 1, k, l, eqn_idx%adv%beg)
982
983 moncon = (acr - ac)*(ac - acl)
984
985 if (ac >= ic_eps .and. ac <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
986
987 if (acr - acl > 0._wp) then
988 sign = 1._wp
989 else
990 sign = -1._wp
991 end if
992
993 qmin = min(acr, acl)
994 qmax = max(acr, acl) - qmin
995
996 c = (ac - qmin + sgm_eps)/(qmax + sgm_eps)
997 b = exp(sign*ic_beta*(2._wp*c - 1._wp))
998 a = (b/cosh(ic_beta) - 1._wp)/tanh(ic_beta)
999
1000 ! Left reconstruction
1001 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*a)
1002 if (athinc < ic_eps) athinc = ic_eps
1003 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1004 vl_rs_vf_x(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_x(j, k, l, &
1005 & eqn_idx%cont%beg)/vl_rs_vf_x(j, k, l, eqn_idx%adv%beg)*athinc
1006 vl_rs_vf_x(j, k, l, eqn_idx%cont%end) = vl_rs_vf_x(j, k, l, &
1007 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_x(j, k, l, &
1008 & eqn_idx%adv%beg))*(1._wp - athinc)
1009 vl_rs_vf_x(j, k, l, eqn_idx%adv%beg) = athinc
1010 vl_rs_vf_x(j, k, l, eqn_idx%adv%end) = 1 - athinc
1011
1012 ! Right reconstruction
1013 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1014 if (athinc < ic_eps) athinc = ic_eps
1015 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1016 vr_rs_vf_x(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_x(j, k, l, &
1017 & eqn_idx%cont%beg)/vl_rs_vf_x(j, k, l, eqn_idx%adv%beg)*athinc
1018 vr_rs_vf_x(j, k, l, eqn_idx%cont%end) = vl_rs_vf_x(j, k, l, &
1019 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_x(j, k, l, &
1020 & eqn_idx%adv%beg))*(1._wp - athinc)
1021 vr_rs_vf_x(j, k, l, eqn_idx%adv%beg) = athinc
1022 vr_rs_vf_x(j, k, l, eqn_idx%adv%end) = 1 - athinc
1023 end if
1024 end do
1025 end do
1026 end do
1027
1028# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1029#if defined(MFC_OpenACC)
1030# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1031!$acc end parallel loop
1032# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1033#elif defined(MFC_OpenMP)
1034# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1035
1036# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1037!$omp end target teams loop
1038# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1039#endif
1040 end if
1041# 233 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1042 if (muscl_dir == 2) then
1043
1044# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1045
1046# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1047#if defined(MFC_OpenACC)
1048# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1049!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1050# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1051#elif defined(MFC_OpenMP)
1052# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1053
1054# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1055
1056# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1057
1058# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1059!$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, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1060# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1061#endif
1062 do l = is3_muscl%beg, is3_muscl%end
1063 do k = is2_muscl%beg, is2_muscl%end
1064 do j = is1_muscl%beg, is1_muscl%end
1065 acl = v_rs_ws_y_muscl(j - 1, k, l, eqn_idx%adv%beg)
1066 ac = v_rs_ws_y_muscl(j, k, l, eqn_idx%adv%beg)
1067 acr = v_rs_ws_y_muscl(j + 1, k, l, eqn_idx%adv%beg)
1068
1069 moncon = (acr - ac)*(ac - acl)
1070
1071 if (ac >= ic_eps .and. ac <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
1072
1073 if (acr - acl > 0._wp) then
1074 sign = 1._wp
1075 else
1076 sign = -1._wp
1077 end if
1078
1079 qmin = min(acr, acl)
1080 qmax = max(acr, acl) - qmin
1081
1082 c = (ac - qmin + sgm_eps)/(qmax + sgm_eps)
1083 b = exp(sign*ic_beta*(2._wp*c - 1._wp))
1084 a = (b/cosh(ic_beta) - 1._wp)/tanh(ic_beta)
1085
1086 ! Left reconstruction
1087 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*a)
1088 if (athinc < ic_eps) athinc = ic_eps
1089 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1090 vl_rs_vf_y(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_y(j, k, l, &
1091 & eqn_idx%cont%beg)/vl_rs_vf_y(j, k, l, eqn_idx%adv%beg)*athinc
1092 vl_rs_vf_y(j, k, l, eqn_idx%cont%end) = vl_rs_vf_y(j, k, l, &
1093 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_y(j, k, l, &
1094 & eqn_idx%adv%beg))*(1._wp - athinc)
1095 vl_rs_vf_y(j, k, l, eqn_idx%adv%beg) = athinc
1096 vl_rs_vf_y(j, k, l, eqn_idx%adv%end) = 1 - athinc
1097
1098 ! Right reconstruction
1099 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1100 if (athinc < ic_eps) athinc = ic_eps
1101 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1102 vr_rs_vf_y(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_y(j, k, l, &
1103 & eqn_idx%cont%beg)/vl_rs_vf_y(j, k, l, eqn_idx%adv%beg)*athinc
1104 vr_rs_vf_y(j, k, l, eqn_idx%cont%end) = vl_rs_vf_y(j, k, l, &
1105 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_y(j, k, l, &
1106 & eqn_idx%adv%beg))*(1._wp - athinc)
1107 vr_rs_vf_y(j, k, l, eqn_idx%adv%beg) = athinc
1108 vr_rs_vf_y(j, k, l, eqn_idx%adv%end) = 1 - athinc
1109 end if
1110 end do
1111 end do
1112 end do
1113
1114# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1115#if defined(MFC_OpenACC)
1116# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1117!$acc end parallel loop
1118# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1119#elif defined(MFC_OpenMP)
1120# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1121
1122# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1123!$omp end target teams loop
1124# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1125#endif
1126 end if
1127# 233 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1128 if (muscl_dir == 3) then
1129
1130# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1131
1132# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1133#if defined(MFC_OpenACC)
1134# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1135!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1136# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1137#elif defined(MFC_OpenMP)
1138# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1139
1140# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1141
1142# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1143
1144# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1145!$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, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1146# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1147#endif
1148 do l = is3_muscl%beg, is3_muscl%end
1149 do k = is2_muscl%beg, is2_muscl%end
1150 do j = is1_muscl%beg, is1_muscl%end
1151 acl = v_rs_ws_z_muscl(j - 1, k, l, eqn_idx%adv%beg)
1152 ac = v_rs_ws_z_muscl(j, k, l, eqn_idx%adv%beg)
1153 acr = v_rs_ws_z_muscl(j + 1, k, l, eqn_idx%adv%beg)
1154
1155 moncon = (acr - ac)*(ac - acl)
1156
1157 if (ac >= ic_eps .and. ac <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
1158
1159 if (acr - acl > 0._wp) then
1160 sign = 1._wp
1161 else
1162 sign = -1._wp
1163 end if
1164
1165 qmin = min(acr, acl)
1166 qmax = max(acr, acl) - qmin
1167
1168 c = (ac - qmin + sgm_eps)/(qmax + sgm_eps)
1169 b = exp(sign*ic_beta*(2._wp*c - 1._wp))
1170 a = (b/cosh(ic_beta) - 1._wp)/tanh(ic_beta)
1171
1172 ! Left reconstruction
1173 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*a)
1174 if (athinc < ic_eps) athinc = ic_eps
1175 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1176 vl_rs_vf_z(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_z(j, k, l, &
1177 & eqn_idx%cont%beg)/vl_rs_vf_z(j, k, l, eqn_idx%adv%beg)*athinc
1178 vl_rs_vf_z(j, k, l, eqn_idx%cont%end) = vl_rs_vf_z(j, k, l, &
1179 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_z(j, k, l, &
1180 & eqn_idx%adv%beg))*(1._wp - athinc)
1181 vl_rs_vf_z(j, k, l, eqn_idx%adv%beg) = athinc
1182 vl_rs_vf_z(j, k, l, eqn_idx%adv%end) = 1 - athinc
1183
1184 ! Right reconstruction
1185 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1186 if (athinc < ic_eps) athinc = ic_eps
1187 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1188 vr_rs_vf_z(j, k, l, eqn_idx%cont%beg) = vl_rs_vf_z(j, k, l, &
1189 & eqn_idx%cont%beg)/vl_rs_vf_z(j, k, l, eqn_idx%adv%beg)*athinc
1190 vr_rs_vf_z(j, k, l, eqn_idx%cont%end) = vl_rs_vf_z(j, k, l, &
1191 & eqn_idx%cont%end)/(1._wp - vl_rs_vf_z(j, k, l, &
1192 & eqn_idx%adv%beg))*(1._wp - athinc)
1193 vr_rs_vf_z(j, k, l, eqn_idx%adv%beg) = athinc
1194 vr_rs_vf_z(j, k, l, eqn_idx%adv%end) = 1 - athinc
1195 end if
1196 end do
1197 end do
1198 end do
1199
1200# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1201#if defined(MFC_OpenACC)
1202# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1203!$acc end parallel loop
1204# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1205#elif defined(MFC_OpenMP)
1206# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1207
1208# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1209!$omp end target teams loop
1210# 286 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1211#endif
1212 end if
1213# 289 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1214
1215 end subroutine s_interface_compression
1216
1217 !> Reshape cell-averaged variable data into direction-local work arrays for MUSCL reconstruction
1218 subroutine s_initialize_muscl(v_vf, muscl_dir)
1219
1220 type(scalar_field), dimension(:), intent(in) :: v_vf
1221 integer, intent(in) :: muscl_dir
1222 integer :: j, k, l, q !< Generic loop iterators
1223 ! Determine MUSCL-reconstructed variables and map coordinate directions
1224
1225 v_size = ubound(v_vf, 1)
1226
1227# 301 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1228#if defined(MFC_OpenACC)
1229# 301 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1230!$acc update device(v_size)
1231# 301 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1232#elif defined(MFC_OpenMP)
1233# 301 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1234!$omp target update to(v_size)
1235# 301 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1236#endif
1237
1238 if (muscl_dir == 1) then
1239
1240# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1241
1242# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1243#if defined(MFC_OpenACC)
1244# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1245!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1246# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1247#elif defined(MFC_OpenMP)
1248# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1249
1250# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1251
1252# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1253
1254# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1255!$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, q)
1256# 304 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1257#endif
1258 do j = 1, v_size
1259 do q = is3_muscl%beg, is3_muscl%end
1260 do l = is2_muscl%beg, is2_muscl%end
1261 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1262 v_rs_ws_x_muscl(k, l, q, j) = v_vf(j)%sf(k, l, q)
1263 end do
1264 end do
1265 end do
1266 end do
1267
1268# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1269#if defined(MFC_OpenACC)
1270# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1271!$acc end parallel loop
1272# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1273#elif defined(MFC_OpenMP)
1274# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1275
1276# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1277!$omp end target teams loop
1278# 314 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1279#endif
1280 end if
1281
1282 ! Reshaping/Projecting onto Characteristic Fields in y-direction
1283 if (n == 0) return
1284
1285 if (muscl_dir == 2) then
1286
1287# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1288
1289# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1290#if defined(MFC_OpenACC)
1291# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1292!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1293# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1294#elif defined(MFC_OpenMP)
1295# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1296
1297# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1298
1299# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1300
1301# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1302!$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, q)
1303# 321 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1304#endif
1305 do j = 1, v_size
1306 do q = is3_muscl%beg, is3_muscl%end
1307 do l = is2_muscl%beg, is2_muscl%end
1308 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1309 v_rs_ws_y_muscl(k, l, q, j) = v_vf(j)%sf(l, k, q)
1310 end do
1311 end do
1312 end do
1313 end do
1314
1315# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1316#if defined(MFC_OpenACC)
1317# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1318!$acc end parallel loop
1319# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1320#elif defined(MFC_OpenMP)
1321# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1322
1323# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1324!$omp end target teams loop
1325# 331 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1326#endif
1327 end if
1328
1329 ! Reshaping/Projecting onto Characteristic Fields in z-direction
1330 if (p == 0) return
1331 if (muscl_dir == 3) then
1332
1333# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1334
1335# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1336#if defined(MFC_OpenACC)
1337# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1338!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1339# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1340#elif defined(MFC_OpenMP)
1341# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1342
1343# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1344
1345# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1346
1347# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1348!$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, q)
1349# 337 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1350#endif
1351 do j = 1, v_size
1352 do q = is3_muscl%beg, is3_muscl%end
1353 do l = is2_muscl%beg, is2_muscl%end
1354 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1355 v_rs_ws_z_muscl(k, l, q, j) = v_vf(j)%sf(q, l, k)
1356 end do
1357 end do
1358 end do
1359 end do
1360
1361# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1362#if defined(MFC_OpenACC)
1363# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1364!$acc end parallel loop
1365# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1366#elif defined(MFC_OpenMP)
1367# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1368
1369# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1370!$omp end target teams loop
1371# 347 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1372#endif
1373 end if
1374
1375 end subroutine s_initialize_muscl
1376
1377 !> Finalize the MUSCL module
1378 subroutine s_finalize_muscl_module()
1379
1380#ifdef MFC_DEBUG
1381# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1382 block
1383# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1384 use iso_fortran_env, only: output_unit
1385# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1386
1387# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1388 print *, 'm_muscl.fpp:355: ', '@:DEALLOCATE(v_rs_ws_x_muscl)'
1389# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1390
1391# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1392 call flush (output_unit)
1393# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1394 end block
1395# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1396#endif
1397# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1398
1399# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1400#if defined(MFC_OpenACC)
1401# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1402!$acc exit data delete(v_rs_ws_x_muscl)
1403# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1404#elif defined(MFC_OpenMP)
1405# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1406!$omp target exit data map(release:v_rs_ws_x_muscl)
1407# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1408#endif
1409# 355 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1410 deallocate (v_rs_ws_x_muscl)
1411
1412 if (n == 0) return
1413
1414#ifdef MFC_DEBUG
1415# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1416 block
1417# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1418 use iso_fortran_env, only: output_unit
1419# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1420
1421# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1422 print *, 'm_muscl.fpp:359: ', '@:DEALLOCATE(v_rs_ws_y_muscl)'
1423# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1424
1425# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1426 call flush (output_unit)
1427# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1428 end block
1429# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1430#endif
1431# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1432
1433# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1434#if defined(MFC_OpenACC)
1435# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1436!$acc exit data delete(v_rs_ws_y_muscl)
1437# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1438#elif defined(MFC_OpenMP)
1439# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1440!$omp target exit data map(release:v_rs_ws_y_muscl)
1441# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1442#endif
1443# 359 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1444 deallocate (v_rs_ws_y_muscl)
1445
1446 if (p == 0) return
1447
1448#ifdef MFC_DEBUG
1449# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1450 block
1451# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1452 use iso_fortran_env, only: output_unit
1453# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1454
1455# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1456 print *, 'm_muscl.fpp:363: ', '@:DEALLOCATE(v_rs_ws_z_muscl)'
1457# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1458
1459# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1460 call flush (output_unit)
1461# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1462 end block
1463# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1464#endif
1465# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1466
1467# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1468#if defined(MFC_OpenACC)
1469# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1470!$acc exit data delete(v_rs_ws_z_muscl)
1471# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1472#elif defined(MFC_OpenMP)
1473# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1474!$omp target exit data map(release:v_rs_ws_z_muscl)
1475# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1476#endif
1477# 363 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1478 deallocate (v_rs_ws_z_muscl)
1479
1480 end subroutine s_finalize_muscl_module
1481
1482end module m_muscl
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:799
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:904
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:352
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:352
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:328
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328
m_muscl
MUSCL reconstruction with interface sharpening for contact-preserving advection.
Definition m_muscl.fpp.f90:317
m_muscl::v_rs_ws_z_muscl
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_z_muscl
Definition m_muscl.fpp.f90:363
m_muscl::is2_muscl
type(int_bounds_info) is2_muscl
Definition m_muscl.fpp.f90:344
m_muscl::is3_muscl
type(int_bounds_info) is3_muscl
Definition m_muscl.fpp.f90:344
m_muscl::v_rs_ws_y_muscl
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_y_muscl
Definition m_muscl.fpp.f90:363
m_muscl::s_initialize_muscl
subroutine s_initialize_muscl(v_vf, muscl_dir)
Reshape cell-averaged variable data into direction-local work arrays for MUSCL reconstruction.
Definition m_muscl.fpp.f90:1219
m_muscl::s_interface_compression
subroutine, public s_interface_compression(vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, muscl_dir, is1_muscl_d, is2_muscl_d, is3_muscl_d)
Apply THINC interface-compression to sharpen volume-fraction reconstructions at material interfaces.
Definition m_muscl.fpp.f90:947
m_muscl::is1_muscl
type(int_bounds_info) is1_muscl
Definition m_muscl.fpp.f90:344
m_muscl::s_muscl
subroutine, public s_muscl(v_vf, vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, 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:532
m_muscl::s_initialize_muscl_module
subroutine, public s_initialize_muscl_module()
Allocate and initialize MUSCL reconstruction working arrays.
Definition m_muscl.fpp.f90:381
m_muscl::v_size
integer v_size
Definition m_muscl.fpp.f90:331
m_muscl::s_finalize_muscl_module
subroutine, public s_finalize_muscl_module()
Finalize the MUSCL module.
Definition m_muscl.fpp.f90:1379
m_muscl::v_rs_ws_x_muscl
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_x_muscl
Definition m_muscl.fpp.f90:363
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411