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