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