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, advxb)
980 ac = v_rs_ws_x_muscl(j, k, l, advxb)
981 acr = v_rs_ws_x_muscl(j + 1, k, l, advxb)
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, contxb) = vl_rs_vf_x(j, k, l, contxb)/vl_rs_vf_x(j, k, &
1005 & l, advxb)*athinc
1006 vl_rs_vf_x(j, k, l, contxe) = vl_rs_vf_x(j, k, l, &
1007 & contxe)/(1._wp - vl_rs_vf_x(j, k, l, advxb))*(1._wp - athinc)
1008 vl_rs_vf_x(j, k, l, advxb) = athinc
1009 vl_rs_vf_x(j, k, l, advxe) = 1 - athinc
1010
1011 ! Right reconstruction
1012 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1013 if (athinc < ic_eps) athinc = ic_eps
1014 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1015 vr_rs_vf_x(j, k, l, contxb) = vl_rs_vf_x(j, k, l, contxb)/vl_rs_vf_x(j, k, &
1016 & l, advxb)*athinc
1017 vr_rs_vf_x(j, k, l, contxe) = vl_rs_vf_x(j, k, l, &
1018 & contxe)/(1._wp - vl_rs_vf_x(j, k, l, advxb))*(1._wp - athinc)
1019 vr_rs_vf_x(j, k, l, advxb) = athinc
1020 vr_rs_vf_x(j, k, l, advxe) = 1 - athinc
1021 end if
1022 end do
1023 end do
1024 end do
1025
1026# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1027#if defined(MFC_OpenACC)
1028# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1029!$acc end parallel loop
1030# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1031#elif defined(MFC_OpenMP)
1032# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1033
1034# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1035!$omp end target teams loop
1036# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1037#endif
1038 end if
1039# 233 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1040 if (muscl_dir == 2) then
1041
1042# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1043
1044# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1045#if defined(MFC_OpenACC)
1046# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1047!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1048# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1049#elif defined(MFC_OpenMP)
1050# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1051
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!$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)
1058# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1059#endif
1060 do l = is3_muscl%beg, is3_muscl%end
1061 do k = is2_muscl%beg, is2_muscl%end
1062 do j = is1_muscl%beg, is1_muscl%end
1063 acl = v_rs_ws_y_muscl(j - 1, k, l, advxb)
1064 ac = v_rs_ws_y_muscl(j, k, l, advxb)
1065 acr = v_rs_ws_y_muscl(j + 1, k, l, advxb)
1066
1067 moncon = (acr - ac)*(ac - acl)
1068
1069 if (ac >= ic_eps .and. ac <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
1070
1071 if (acr - acl > 0._wp) then
1072 sign = 1._wp
1073 else
1074 sign = -1._wp
1075 end if
1076
1077 qmin = min(acr, acl)
1078 qmax = max(acr, acl) - qmin
1079
1080 c = (ac - qmin + sgm_eps)/(qmax + sgm_eps)
1081 b = exp(sign*ic_beta*(2._wp*c - 1._wp))
1082 a = (b/cosh(ic_beta) - 1._wp)/tanh(ic_beta)
1083
1084 ! Left reconstruction
1085 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*a)
1086 if (athinc < ic_eps) athinc = ic_eps
1087 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1088 vl_rs_vf_y(j, k, l, contxb) = vl_rs_vf_y(j, k, l, contxb)/vl_rs_vf_y(j, k, &
1089 & l, advxb)*athinc
1090 vl_rs_vf_y(j, k, l, contxe) = vl_rs_vf_y(j, k, l, &
1091 & contxe)/(1._wp - vl_rs_vf_y(j, k, l, advxb))*(1._wp - athinc)
1092 vl_rs_vf_y(j, k, l, advxb) = athinc
1093 vl_rs_vf_y(j, k, l, advxe) = 1 - athinc
1094
1095 ! Right reconstruction
1096 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1097 if (athinc < ic_eps) athinc = ic_eps
1098 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1099 vr_rs_vf_y(j, k, l, contxb) = vl_rs_vf_y(j, k, l, contxb)/vl_rs_vf_y(j, k, &
1100 & l, advxb)*athinc
1101 vr_rs_vf_y(j, k, l, contxe) = vl_rs_vf_y(j, k, l, &
1102 & contxe)/(1._wp - vl_rs_vf_y(j, k, l, advxb))*(1._wp - athinc)
1103 vr_rs_vf_y(j, k, l, advxb) = athinc
1104 vr_rs_vf_y(j, k, l, advxe) = 1 - athinc
1105 end if
1106 end do
1107 end do
1108 end do
1109
1110# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1111#if defined(MFC_OpenACC)
1112# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1113!$acc end parallel loop
1114# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1115#elif defined(MFC_OpenMP)
1116# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1117
1118# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1119!$omp end target teams loop
1120# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1121#endif
1122 end if
1123# 233 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1124 if (muscl_dir == 3) then
1125
1126# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1127
1128# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1129#if defined(MFC_OpenACC)
1130# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1131!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l, aCL, aC, aCR, aTHINC, moncon, sign, qmin, qmax)
1132# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1133#elif defined(MFC_OpenMP)
1134# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1135
1136# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1137
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!$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)
1142# 234 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1143#endif
1144 do l = is3_muscl%beg, is3_muscl%end
1145 do k = is2_muscl%beg, is2_muscl%end
1146 do j = is1_muscl%beg, is1_muscl%end
1147 acl = v_rs_ws_z_muscl(j - 1, k, l, advxb)
1148 ac = v_rs_ws_z_muscl(j, k, l, advxb)
1149 acr = v_rs_ws_z_muscl(j + 1, k, l, advxb)
1150
1151 moncon = (acr - ac)*(ac - acl)
1152
1153 if (ac >= ic_eps .and. ac <= 1._wp - ic_eps .and. moncon > moncon_cutoff) then ! Interface cell
1154
1155 if (acr - acl > 0._wp) then
1156 sign = 1._wp
1157 else
1158 sign = -1._wp
1159 end if
1160
1161 qmin = min(acr, acl)
1162 qmax = max(acr, acl) - qmin
1163
1164 c = (ac - qmin + sgm_eps)/(qmax + sgm_eps)
1165 b = exp(sign*ic_beta*(2._wp*c - 1._wp))
1166 a = (b/cosh(ic_beta) - 1._wp)/tanh(ic_beta)
1167
1168 ! Left reconstruction
1169 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*a)
1170 if (athinc < ic_eps) athinc = ic_eps
1171 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1172 vl_rs_vf_z(j, k, l, contxb) = vl_rs_vf_z(j, k, l, contxb)/vl_rs_vf_z(j, k, &
1173 & l, advxb)*athinc
1174 vl_rs_vf_z(j, k, l, contxe) = vl_rs_vf_z(j, k, l, &
1175 & contxe)/(1._wp - vl_rs_vf_z(j, k, l, advxb))*(1._wp - athinc)
1176 vl_rs_vf_z(j, k, l, advxb) = athinc
1177 vl_rs_vf_z(j, k, l, advxe) = 1 - athinc
1178
1179 ! Right reconstruction
1180 athinc = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + a)/(1._wp + a*tanh(ic_beta)))
1181 if (athinc < ic_eps) athinc = ic_eps
1182 if (athinc > 1 - ic_eps) athinc = 1 - ic_eps
1183 vr_rs_vf_z(j, k, l, contxb) = vl_rs_vf_z(j, k, l, contxb)/vl_rs_vf_z(j, k, &
1184 & l, advxb)*athinc
1185 vr_rs_vf_z(j, k, l, contxe) = vl_rs_vf_z(j, k, l, &
1186 & contxe)/(1._wp - vl_rs_vf_z(j, k, l, advxb))*(1._wp - athinc)
1187 vr_rs_vf_z(j, k, l, advxb) = athinc
1188 vr_rs_vf_z(j, k, l, advxe) = 1 - athinc
1189 end if
1190 end do
1191 end do
1192 end do
1193
1194# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1195#if defined(MFC_OpenACC)
1196# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1197!$acc end parallel loop
1198# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1199#elif defined(MFC_OpenMP)
1200# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1201
1202# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1203!$omp end target teams loop
1204# 284 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1205#endif
1206 end if
1207# 287 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1208
1209 end subroutine s_interface_compression
1210
1211 !> Reshape cell-averaged variable data into direction-local work arrays for MUSCL reconstruction
1212 subroutine s_initialize_muscl(v_vf, muscl_dir)
1213
1214 type(scalar_field), dimension(:), intent(in) :: v_vf
1215 integer, intent(in) :: muscl_dir
1216 integer :: j, k, l, q !< Generic loop iterators
1217 ! Determine MUSCL-reconstructed variables and map coordinate directions
1218
1219 v_size = ubound(v_vf, 1)
1220
1221# 299 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1222#if defined(MFC_OpenACC)
1223# 299 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1224!$acc update device(v_size)
1225# 299 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1226#elif defined(MFC_OpenMP)
1227# 299 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1228!$omp target update to(v_size)
1229# 299 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1230#endif
1231
1232 if (muscl_dir == 1) then
1233
1234# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1235
1236# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1237#if defined(MFC_OpenACC)
1238# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1239!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1240# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1241#elif defined(MFC_OpenMP)
1242# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1243
1244# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1245
1246# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1247
1248# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1249!$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)
1250# 302 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1251#endif
1252 do j = 1, v_size
1253 do q = is3_muscl%beg, is3_muscl%end
1254 do l = is2_muscl%beg, is2_muscl%end
1255 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1256 v_rs_ws_x_muscl(k, l, q, j) = v_vf(j)%sf(k, l, q)
1257 end do
1258 end do
1259 end do
1260 end do
1261
1262# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1263#if defined(MFC_OpenACC)
1264# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1265!$acc end parallel loop
1266# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1267#elif defined(MFC_OpenMP)
1268# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1269
1270# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1271!$omp end target teams loop
1272# 312 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1273#endif
1274 end if
1275
1276 ! Reshaping/Projecting onto Characteristic Fields in y-direction
1277 if (n == 0) return
1278
1279 if (muscl_dir == 2) then
1280
1281# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1282
1283# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1284#if defined(MFC_OpenACC)
1285# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1286!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1287# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1288#elif defined(MFC_OpenMP)
1289# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1290
1291# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1292
1293# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1294
1295# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1296!$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)
1297# 319 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1298#endif
1299 do j = 1, v_size
1300 do q = is3_muscl%beg, is3_muscl%end
1301 do l = is2_muscl%beg, is2_muscl%end
1302 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1303 v_rs_ws_y_muscl(k, l, q, j) = v_vf(j)%sf(l, k, q)
1304 end do
1305 end do
1306 end do
1307 end do
1308
1309# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1310#if defined(MFC_OpenACC)
1311# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1312!$acc end parallel loop
1313# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1314#elif defined(MFC_OpenMP)
1315# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1316
1317# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1318!$omp end target teams loop
1319# 329 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1320#endif
1321 end if
1322
1323 ! Reshaping/Projecting onto Characteristic Fields in z-direction
1324 if (p == 0) return
1325 if (muscl_dir == 3) then
1326
1327# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1328
1329# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1330#if defined(MFC_OpenACC)
1331# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1332!$acc parallel loop collapse(4) gang vector default(present) private(j, k, l, q)
1333# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1334#elif defined(MFC_OpenMP)
1335# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1336
1337# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1338
1339# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1340
1341# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1342!$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)
1343# 335 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1344#endif
1345 do j = 1, v_size
1346 do q = is3_muscl%beg, is3_muscl%end
1347 do l = is2_muscl%beg, is2_muscl%end
1348 do k = is1_muscl%beg - muscl_polyn, is1_muscl%end + muscl_polyn
1349 v_rs_ws_z_muscl(k, l, q, j) = v_vf(j)%sf(q, l, k)
1350 end do
1351 end do
1352 end do
1353 end do
1354
1355# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1356#if defined(MFC_OpenACC)
1357# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1358!$acc end parallel loop
1359# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1360#elif defined(MFC_OpenMP)
1361# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1362
1363# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1364!$omp end target teams loop
1365# 345 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1366#endif
1367 end if
1368
1369 end subroutine s_initialize_muscl
1370
1371 !> Finalize the MUSCL module
1372 subroutine s_finalize_muscl_module()
1373
1374#ifdef MFC_DEBUG
1375# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1376 block
1377# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1378 use iso_fortran_env, only: output_unit
1379# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1380
1381# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1382 print *, 'm_muscl.fpp:353: ', '@:DEALLOCATE(v_rs_ws_x_muscl)'
1383# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1384
1385# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1386 call flush (output_unit)
1387# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1388 end block
1389# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1390#endif
1391# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1392
1393# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1394#if defined(MFC_OpenACC)
1395# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1396!$acc exit data delete(v_rs_ws_x_muscl)
1397# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1398#elif defined(MFC_OpenMP)
1399# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1400!$omp target exit data map(release:v_rs_ws_x_muscl)
1401# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1402#endif
1403# 353 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1404 deallocate (v_rs_ws_x_muscl)
1405
1406 if (n == 0) return
1407
1408#ifdef MFC_DEBUG
1409# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1410 block
1411# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1412 use iso_fortran_env, only: output_unit
1413# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1414
1415# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1416 print *, 'm_muscl.fpp:357: ', '@:DEALLOCATE(v_rs_ws_y_muscl)'
1417# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1418
1419# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1420 call flush (output_unit)
1421# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1422 end block
1423# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1424#endif
1425# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1426
1427# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1428#if defined(MFC_OpenACC)
1429# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1430!$acc exit data delete(v_rs_ws_y_muscl)
1431# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1432#elif defined(MFC_OpenMP)
1433# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1434!$omp target exit data map(release:v_rs_ws_y_muscl)
1435# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1436#endif
1437# 357 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1438 deallocate (v_rs_ws_y_muscl)
1439
1440 if (p == 0) return
1441
1442#ifdef MFC_DEBUG
1443# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1444 block
1445# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1446 use iso_fortran_env, only: output_unit
1447# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1448
1449# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1450 print *, 'm_muscl.fpp:361: ', '@:DEALLOCATE(v_rs_ws_z_muscl)'
1451# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1452
1453# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1454 call flush (output_unit)
1455# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1456 end block
1457# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1458#endif
1459# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1460
1461# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1462#if defined(MFC_OpenACC)
1463# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1464!$acc exit data delete(v_rs_ws_z_muscl)
1465# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1466#elif defined(MFC_OpenMP)
1467# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1468!$omp target exit data map(release:v_rs_ws_z_muscl)
1469# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1470#endif
1471# 361 "/home/runner/work/MFC/MFC/src/simulation/m_muscl.fpp"
1472 deallocate (v_rs_ws_z_muscl)
1473
1474 end subroutine s_finalize_muscl_module
1475
1476end module m_muscl
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1064
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1064
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1064
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:772
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:914
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:1213
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:1373
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:405