MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_weno.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2!>
3!! @file
4!! @brief Contains module m_weno
5# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
6! This file exists so that Fypp can be run without generating case.fpp files for
7! each target. This is useful when generating documentation, for example. This
8! should also let MFC be built with CMake directly, without invoking mfc.sh.
9
10! For pre-process.
11# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
12
13! For moving immersed boundaries in simulation
14# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15# 5 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
16# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
17# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
19# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42! New line at end of file is required for FYPP
43# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
44# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
45# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
46# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69! New line at end of file is required for FYPP
70# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
71
72# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
74# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 245 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 376 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148! New line at end of file is required for FYPP
149# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
150# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
151# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
152# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175! New line at end of file is required for FYPP
176# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
177
178# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 308 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233! New line at end of file is required for FYPP
234# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
235
236# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
239
240# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242# 76 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244# 91 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246# 102 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248# 115 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252# 154 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254# 165 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256# 176 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258# 187 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260# 198 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262# 208 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266# 220 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268# 226 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270# 232 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272# 234 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273# 235 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274! New line at end of file is required for FYPP
275# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
276
277# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
278
279! Caution:
280! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
281! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
282! For an example see misc/nvidia_uvm/bind.sh.
283# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
284
285# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
286
287# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
288
289# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
290
291# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
292
293# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
296
297# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
298! New line at end of file is required for FYPP
299# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
300
301!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
302module m_weno
303
304 use m_derived_types !< definitions of the derived types
305
306 use m_global_parameters !< definitions of the global parameters
307
308 use m_variables_conversion !< state variables type conversion procedures
309
310 ! $:USE_GPU_MODULE()
311
312 use m_mpi_proxy
313
314 use m_muscl !< for interface compression
315
316 private; public :: s_initialize_weno_module, s_initialize_weno, s_finalize_weno_module, s_weno
317
318 !> @name The cell-average variables that will be WENO-reconstructed. Formerly, they
319 !! are stored in v_vf. However, they are transferred to v_rs_wsL and v_rs_wsR
320 !! as to be reshaped (RS) and/or characteristically decomposed. The reshaping
321 !! allows the WENO procedure to be independent of the coordinate direction of
322 !! the reconstruction. Lastly, notice that the left (L) and right (R) results
323 !! of the characteristic decomposition are stored in custom-constructed WENO-
324 !! stencils (WS) that are annexed to each position of a given scalar field.
325 !> @{
326 real(wp), allocatable, dimension(:, :, :, :) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z
327 !> @}
328
329# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
330#if defined(MFC_OpenACC)
331# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
332!$acc declare create(v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
333# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
334#elif defined(MFC_OpenMP)
335# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
336!$omp declare target (v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
337# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
338#endif
339
340 ! WENO Coefficients
341
342 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at
343 !! the left and right quadrature points (QP), in the x-, y- and z-directions.
344 !! Note that the first dimension of the array identifies the polynomial, the
345 !! second dimension identifies the position of its coefficients and the last
346 !! dimension denotes the cell-location in the relevant coordinate direction.
347 !> @{
348 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_x
349 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_y
350 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_z
351 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_x
352 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_y
353 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_z
354 !> @}
355
356# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
357#if defined(MFC_OpenACC)
358# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
359!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
360# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
361#elif defined(MFC_OpenMP)
362# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
363!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
364# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
365#endif
366
367# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
368#if defined(MFC_OpenACC)
369# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
370!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
371# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
372#elif defined(MFC_OpenMP)
373# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
374!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
375# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
376#endif
377
378 !> @name The ideal weights at the left and the right cell-boundaries and at the
379 !! left and the right quadrature points, in x-, y- and z-directions. Note
380 !! that the first dimension of the array identifies the weight, while the
381 !! last denotes the cell-location in the relevant coordinate direction.
382 !> @{
383 real(wp), target, allocatable, dimension(:, :) :: d_cbl_x
384 real(wp), target, allocatable, dimension(:, :) :: d_cbl_y
385 real(wp), target, allocatable, dimension(:, :) :: d_cbl_z
386
387 real(wp), target, allocatable, dimension(:, :) :: d_cbr_x
388 real(wp), target, allocatable, dimension(:, :) :: d_cbr_y
389 real(wp), target, allocatable, dimension(:, :) :: d_cbr_z
390 !> @}
391
392# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
393#if defined(MFC_OpenACC)
394# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
395!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
396# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
397#elif defined(MFC_OpenMP)
398# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
399!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
400# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
401#endif
402
403 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note
404 !! that the first array dimension identifies the smoothness indicator, the
405 !! second identifies the position of its coefficients and the last denotes
406 !! the cell-location in the relevant coordinate direction.
407 !> @{
408 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_x
409 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_y
410 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_z
411 !> @}
412
413# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414#if defined(MFC_OpenACC)
415# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
417# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
418#elif defined(MFC_OpenMP)
419# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
420!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
421# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
422#endif
423
424 ! END: WENO Coefficients
425
426 integer :: v_size !< Number of WENO-reconstructed cell-average variables
427
428# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
429#if defined(MFC_OpenACC)
430# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
431!$acc declare create(v_size)
432# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
433#elif defined(MFC_OpenMP)
434# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
435!$omp declare target (v_size)
436# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
437#endif
438
439 !> @name Indical bounds in the s1-, s2- and s3-directions
440 !> @{
441 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
442#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
443
444# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
445#if defined(MFC_OpenACC)
446# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447!$acc declare create(is1_weno, is2_weno, is3_weno)
448# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449#elif defined(MFC_OpenMP)
450# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451!$omp declare target (is1_weno, is2_weno, is3_weno)
452# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
453#endif
454#endif
455 !
456 !> @}
457
458contains
459
460 !> The computation of parameters, the allocation of memory,
461 !! the association of pointers and/or the execution of any
462 !! other procedures that are necessary to setup the module.
463 impure subroutine s_initialize_weno_module
464
465 if (weno_order == 1) return
466
467 ! Allocating/Computing WENO Coefficients in x-direction
468 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
469 if (n == 0) then
470 is2_weno%beg = 0
471 else
472 is2_weno%beg = -buff_size;
473 end if
474
475 is2_weno%end = n - is2_weno%beg
476
477 if (p == 0) then
478 is3_weno%beg = 0
479 else
480 is3_weno%beg = -buff_size
481 end if
482
483 is3_weno%end = p - is3_weno%beg
484
485#ifdef MFC_DEBUG
486# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
487 block
488# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
489 use iso_fortran_env, only: output_unit
490# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
491
492# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
493 print *, 'm_weno.fpp:121: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
494# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
495
496# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
497 call flush (output_unit)
498# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
499 end block
500# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
501#endif
502# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
503 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
504# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
505
506# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
507
508# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
509#if defined(MFC_OpenACC)
510# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
511!$acc enter data create(poly_coef_cbL_x)
512# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
513#elif defined(MFC_OpenMP)
514# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
515!$omp target enter data map(always,alloc:poly_coef_cbL_x)
516# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
517#endif
518# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
519#ifdef MFC_DEBUG
520# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
521 block
522# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
523 use iso_fortran_env, only: output_unit
524# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
525
526# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
527 print *, 'm_weno.fpp:123: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
528# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
529
530# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
531 call flush (output_unit)
532# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
533 end block
534# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
535#endif
536# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
537 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
538# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
539
540# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
541
542# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
543#if defined(MFC_OpenACC)
544# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
545!$acc enter data create(poly_coef_cbR_x)
546# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
547#elif defined(MFC_OpenMP)
548# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549!$omp target enter data map(always,alloc:poly_coef_cbR_x)
550# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551#endif
552# 125 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553
554#ifdef MFC_DEBUG
555# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
556 block
557# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
558 use iso_fortran_env, only: output_unit
559# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
560
561# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
562 print *, 'm_weno.fpp:126: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
563# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
564
565# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
566 call flush (output_unit)
567# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
568 end block
569# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
570#endif
571# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
572 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
573# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
574
575# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
576
577# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
578#if defined(MFC_OpenACC)
579# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
580!$acc enter data create(d_cbL_x)
581# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
582#elif defined(MFC_OpenMP)
583# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
584!$omp target enter data map(always,alloc:d_cbL_x)
585# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
586#endif
587#ifdef MFC_DEBUG
588# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589 block
590# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591 use iso_fortran_env, only: output_unit
592# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593
594# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595 print *, 'm_weno.fpp:127: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
596# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597
598# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599 call flush (output_unit)
600# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601 end block
602# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603#endif
604# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
606# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607
608# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609
610# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611#if defined(MFC_OpenACC)
612# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613!$acc enter data create(d_cbR_x)
614# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
615#elif defined(MFC_OpenMP)
616# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
617!$omp target enter data map(always,alloc:d_cbR_x)
618# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
619#endif
620
621#ifdef MFC_DEBUG
622# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
623 block
624# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
625 use iso_fortran_env, only: output_unit
626# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
627
628# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
629 print *, 'm_weno.fpp:129: ', '@:ALLOCATE(beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
630# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
631
632# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
633 call flush (output_unit)
634# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
635 end block
636# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
637#endif
638# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
639 allocate (beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
640# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
641
642# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
643
644# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
645#if defined(MFC_OpenACC)
646# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
647!$acc enter data create(beta_coef_x)
648# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
649#elif defined(MFC_OpenMP)
650# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
651!$omp target enter data map(always,alloc:beta_coef_x)
652# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
653#endif
654# 131 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
655 ! Number of cross terms for dvd = (k-1)(k-1+1)/2, where weno_polyn = k-1
656 ! Note: k-1 not k because we are using value differences (dvd) not the values themselves
657
658 call s_compute_weno_coefficients(1, is1_weno)
659
660#ifdef MFC_DEBUG
661# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662 block
663# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664 use iso_fortran_env, only: output_unit
665# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666
667# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668 print *, 'm_weno.fpp:136: ', '@:ALLOCATE(v_rs_ws_x(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
669# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670
671# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672 call flush (output_unit)
673# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674 end block
675# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676#endif
677# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678 allocate (v_rs_ws_x(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
679# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680
681# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
682
683# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
684#if defined(MFC_OpenACC)
685# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
686!$acc enter data create(v_rs_ws_x)
687# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
688#elif defined(MFC_OpenMP)
689# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
690!$omp target enter data map(always,alloc:v_rs_ws_x)
691# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
692#endif
693# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
694
695 ! Allocating/Computing WENO Coefficients in y-direction
696 if (n == 0) return
697
698 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
699 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
700
701 if (p == 0) then
702 is3_weno%beg = 0
703 else
704 is3_weno%beg = -buff_size
705 end if
706
707 is3_weno%end = p - is3_weno%beg
708
709#ifdef MFC_DEBUG
710# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711 block
712# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713 use iso_fortran_env, only: output_unit
714# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715
716# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717 print *, 'm_weno.fpp:153: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
718# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
719
720# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
721 call flush (output_unit)
722# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
723 end block
724# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
725#endif
726# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
727 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
728# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
729
730# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
731
732# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
733#if defined(MFC_OpenACC)
734# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
735!$acc enter data create(poly_coef_cbL_y)
736# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737#elif defined(MFC_OpenMP)
738# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739!$omp target enter data map(always,alloc:poly_coef_cbL_y)
740# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741#endif
742# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743#ifdef MFC_DEBUG
744# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745 block
746# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 use iso_fortran_env, only: output_unit
748# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749
750# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751 print *, 'm_weno.fpp:155: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
752# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753
754# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755 call flush (output_unit)
756# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757 end block
758# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759#endif
760# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
762# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763
764# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765
766# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
767#if defined(MFC_OpenACC)
768# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
769!$acc enter data create(poly_coef_cbR_y)
770# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
771#elif defined(MFC_OpenMP)
772# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
773!$omp target enter data map(always,alloc:poly_coef_cbR_y)
774# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
775#endif
776# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
777
778#ifdef MFC_DEBUG
779# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 block
781# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782 use iso_fortran_env, only: output_unit
783# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784
785# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786 print *, 'm_weno.fpp:158: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
787# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788
789# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790 call flush (output_unit)
791# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792 end block
793# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794#endif
795# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
797# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798
799# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
800
801# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
802#if defined(MFC_OpenACC)
803# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804!$acc enter data create(d_cbL_y)
805# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806#elif defined(MFC_OpenMP)
807# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808!$omp target enter data map(always,alloc:d_cbL_y)
809# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810#endif
811#ifdef MFC_DEBUG
812# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
813 block
814# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
815 use iso_fortran_env, only: output_unit
816# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
817
818# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
819 print *, 'm_weno.fpp:159: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
820# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
821
822# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
823 call flush (output_unit)
824# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
825 end block
826# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
827#endif
828# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
829 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
830# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
831
832# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
833
834# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
835#if defined(MFC_OpenACC)
836# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837!$acc enter data create(d_cbR_y)
838# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839#elif defined(MFC_OpenMP)
840# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841!$omp target enter data map(always,alloc:d_cbR_y)
842# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843#endif
844
845#ifdef MFC_DEBUG
846# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 block
848# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849 use iso_fortran_env, only: output_unit
850# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851
852# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853 print *, 'm_weno.fpp:161: ', '@:ALLOCATE(beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
854# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855
856# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857 call flush (output_unit)
858# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859 end block
860# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861#endif
862# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863 allocate (beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
864# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865
866# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
867
868# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
869#if defined(MFC_OpenACC)
870# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871!$acc enter data create(beta_coef_y)
872# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873#elif defined(MFC_OpenMP)
874# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875!$omp target enter data map(always,alloc:beta_coef_y)
876# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877#endif
878# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879
880 call s_compute_weno_coefficients(2, is2_weno)
881
882#ifdef MFC_DEBUG
883# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
884 block
885# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
886 use iso_fortran_env, only: output_unit
887# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
888
889# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
890 print *, 'm_weno.fpp:166: ', '@:ALLOCATE(v_rs_ws_y(is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
891# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
892
893# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
894 call flush (output_unit)
895# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
896 end block
897# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
898#endif
899# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
900 allocate (v_rs_ws_y(is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
901# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
902
903# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
904
905# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
906#if defined(MFC_OpenACC)
907# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
908!$acc enter data create(v_rs_ws_y)
909# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
910#elif defined(MFC_OpenMP)
911# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
912!$omp target enter data map(always,alloc:v_rs_ws_y)
913# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
914#endif
915# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
916
917 ! Allocating/Computing WENO Coefficients in z-direction
918 if (p == 0) return
919
920 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
921 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
922 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
923
924#ifdef MFC_DEBUG
925# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
926 block
927# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
928 use iso_fortran_env, only: output_unit
929# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
930
931# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
932 print *, 'm_weno.fpp:176: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
933# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
934
935# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
936 call flush (output_unit)
937# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
938 end block
939# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
940#endif
941# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
942 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
943# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
944
945# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
946
947# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948#if defined(MFC_OpenACC)
949# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950!$acc enter data create(poly_coef_cbL_z)
951# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952#elif defined(MFC_OpenMP)
953# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954!$omp target enter data map(always,alloc:poly_coef_cbL_z)
955# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956#endif
957# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958#ifdef MFC_DEBUG
959# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960 block
961# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962 use iso_fortran_env, only: output_unit
963# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964
965# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966 print *, 'm_weno.fpp:178: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
967# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968
969# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970 call flush (output_unit)
971# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972 end block
973# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974#endif
975# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
977# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978
979# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
980
981# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982#if defined(MFC_OpenACC)
983# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984!$acc enter data create(poly_coef_cbR_z)
985# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986#elif defined(MFC_OpenMP)
987# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988!$omp target enter data map(always,alloc:poly_coef_cbR_z)
989# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990#endif
991# 180 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992
993#ifdef MFC_DEBUG
994# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
995 block
996# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
997 use iso_fortran_env, only: output_unit
998# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
999
1000# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1001 print *, 'm_weno.fpp:181: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1002# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1003
1004# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1005 call flush (output_unit)
1006# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1007 end block
1008# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1009#endif
1010# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1011 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1012# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1013
1014# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015
1016# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017#if defined(MFC_OpenACC)
1018# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019!$acc enter data create(d_cbL_z)
1020# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021#elif defined(MFC_OpenMP)
1022# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023!$omp target enter data map(always,alloc:d_cbL_z)
1024# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025#endif
1026#ifdef MFC_DEBUG
1027# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1028 block
1029# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1030 use iso_fortran_env, only: output_unit
1031# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1032
1033# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1034 print *, 'm_weno.fpp:182: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1035# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1036
1037# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1038 call flush (output_unit)
1039# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1040 end block
1041# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1042#endif
1043# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1044 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1045# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1046
1047# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1048
1049# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1050#if defined(MFC_OpenACC)
1051# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1052!$acc enter data create(d_cbR_z)
1053# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1054#elif defined(MFC_OpenMP)
1055# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1056!$omp target enter data map(always,alloc:d_cbR_z)
1057# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1058#endif
1059
1060#ifdef MFC_DEBUG
1061# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1062 block
1063# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1064 use iso_fortran_env, only: output_unit
1065# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1066
1067# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1068 print *, 'm_weno.fpp:184: ', '@:ALLOCATE(beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
1069# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1070
1071# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1072 call flush (output_unit)
1073# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1074 end block
1075# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1076#endif
1077# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1078 allocate (beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
1079# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1080
1081# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1082
1083# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1084#if defined(MFC_OpenACC)
1085# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1086!$acc enter data create(beta_coef_z)
1087# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1088#elif defined(MFC_OpenMP)
1089# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1090!$omp target enter data map(always,alloc:beta_coef_z)
1091# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1092#endif
1093# 186 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1094
1095 call s_compute_weno_coefficients(3, is3_weno)
1096
1097#ifdef MFC_DEBUG
1098# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1099 block
1100# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1101 use iso_fortran_env, only: output_unit
1102# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1103
1104# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1105 print *, 'm_weno.fpp:189: ', '@:ALLOCATE(v_rs_ws_z(is3_weno%beg:is3_weno%end, is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:sys_size))'
1106# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1107
1108# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1109 call flush (output_unit)
1110# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1111 end block
1112# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1113#endif
1114# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1115 allocate (v_rs_ws_z(is3_weno%beg:is3_weno%end, is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:sys_size))
1116# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1117
1118# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1119
1120# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1121#if defined(MFC_OpenACC)
1122# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1123!$acc enter data create(v_rs_ws_z)
1124# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1125#elif defined(MFC_OpenMP)
1126# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1127!$omp target enter data map(always,alloc:v_rs_ws_z)
1128# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1129#endif
1130# 191 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1131
1132 end subroutine s_initialize_weno_module
1133
1134 !> The purpose of this subroutine is to compute the grid
1135 !! dependent coefficients of the WENO polynomials, ideal
1136 !! weights and smoothness indicators, provided the order,
1137 !! the coordinate direction and the location of the WENO
1138 !! reconstruction.
1139 !! @param weno_dir Coordinate direction of the WENO reconstruction
1140 !! @param is Index bounds in the s-direction
1141 subroutine s_compute_weno_coefficients(weno_dir, is)
1142
1143 integer, intent(in) :: weno_dir
1144 type(int_bounds_info), intent(in) :: is
1145 integer :: s
1146
1147 real(wp), pointer, dimension(:) :: s_cb => null() !<
1148 !! Cell-boundary locations in the s-direction
1149
1150 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1151
1152 integer :: i !< Generic loop iterator
1153
1154 real(wp) :: w(1:8) ! Intermediate var for ideal weights: s_cb across overall stencil
1155 real(wp) :: y(1:4) ! Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1156
1157 ! Determining the number of cells, the cell-boundary locations and
1158 ! the boundary conditions in the coordinate direction selected for
1159 ! the WENO reconstruction
1160 if (weno_dir == 1) then
1161 s = m; s_cb => x_cb; bc_s = bc_x
1162 elseif (weno_dir == 2) then
1163 s = n; s_cb => y_cb; bc_s = bc_y
1164 else
1165 s = p; s_cb => z_cb; bc_s = bc_z
1166 end if
1167
1168# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1169 ! Computing WENO3 Coefficients
1170 if (weno_dir == 1) then
1171 if (weno_order == 3) then
1172 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1173
1174 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1175 (s_cb(i) - s_cb(i + 2))
1176 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1177 (s_cb(i - 1) - s_cb(i + 1))
1178
1179 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1180 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1181
1182 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1183 (s_cb(i - 1) - s_cb(i + 2))
1184 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1185 (s_cb(i - 1) - s_cb(i + 2))
1186
1187 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1188 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1189
1190 beta_coef_x(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1191 (s_cb(i) - s_cb(i + 2))**2._wp
1192 beta_coef_x(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1193 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1194
1195 end do
1196
1197 ! Modifying the ideal weights coefficients in the neighborhood
1198 ! of beginning and end Riemann state extrapolation BC to avoid
1199 ! any contributions from outside of the physical domain during
1200 ! the WENO reconstruction
1201 if (null_weights) then
1202 if (bc_s%beg == bc_riemann_extrap) then
1203 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1204 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1205 end if
1206
1207 if (bc_s%end == bc_riemann_extrap) then
1208 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1209 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1210 end if
1211 end if
1212 ! END: Computing WENO3 Coefficients
1213
1214 ! Computing WENO5 Coefficients
1215 elseif (weno_order == 5) then
1216
1217 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1218
1219 poly_coef_cbr_x(i + 1, 0, 0) = &
1220 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1221 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1222 poly_coef_cbr_x(i + 1, 1, 0) = &
1223 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1224 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1225 poly_coef_cbr_x(i + 1, 1, 1) = &
1226 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1227 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1228 poly_coef_cbr_x(i + 1, 2, 1) = &
1229 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1230 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1231 poly_coef_cbl_x(i + 1, 0, 0) = &
1232 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1233 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1234 poly_coef_cbl_x(i + 1, 1, 0) = &
1235 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
1236 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
1237 poly_coef_cbl_x(i + 1, 1, 1) = &
1238 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1239 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1240 poly_coef_cbl_x(i + 1, 2, 1) = &
1241 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
1242 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1243
1244 poly_coef_cbr_x(i + 1, 0, 1) = &
1245 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
1246 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1247 ((s_cb(i) - s_cb(i + 1)))
1248 poly_coef_cbr_x(i + 1, 2, 0) = &
1249 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1250 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
1251 ((s_cb(i + 1) - s_cb(i)))
1252 poly_coef_cbl_x(i + 1, 0, 1) = &
1253 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
1254 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1255 ((s_cb(i + 1) - s_cb(i)))
1256 poly_coef_cbl_x(i + 1, 2, 0) = &
1257 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1258 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
1259 ((s_cb(i) - s_cb(i + 1)))
1260
1261 d_cbr_x(0, i + 1) = &
1262 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1263 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1264 d_cbr_x(2, i + 1) = &
1265 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
1266 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1267 d_cbl_x(0, i + 1) = &
1268 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
1269 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1270 d_cbl_x(2, i + 1) = &
1271 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
1272 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1273
1274 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1275 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1276
1277 beta_coef_x(i + 1, 0, 0) = &
1278 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1279 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1280 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
1281 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1282
1283 beta_coef_x(i + 1, 0, 1) = &
1284 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1285 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
1286 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
1287 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
1288 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
1289 s_cb(i + 1)))
1290
1291 beta_coef_x(i + 1, 0, 2) = &
1292 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1293 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
1294 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
1295 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
1296 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1297
1298 beta_coef_x(i + 1, 1, 0) = &
1299 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1300 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1301 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
1302 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1303
1304 beta_coef_x(i + 1, 1, 1) = &
1305 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
1306 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
1307 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
1308 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
1309 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
1310 s_cb(i)))
1311
1312 beta_coef_x(i + 1, 1, 2) = &
1313 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1314 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1315 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
1316 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1317 s_cb(i + 2))**2._wp)
1318
1319 beta_coef_x(i + 1, 2, 0) = &
1320 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
1321 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
1322 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
1323 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
1324 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1325 s_cb(i + 1))**2._wp)
1326
1327 beta_coef_x(i + 1, 2, 1) = &
1328 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1329 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
1330 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
1331 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
1332 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
1333 s_cb(i - 1)))
1334
1335 beta_coef_x(i + 1, 2, 2) = &
1336 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1337 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1338 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
1339 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1340
1341 end do
1342
1343 ! Modifying the ideal weights coefficients in the neighborhood
1344 ! of beginning and end Riemann state extrapolation BC to avoid
1345 ! any contributions from outside of the physical domain during
1346 ! the WENO reconstruction
1347 if (null_weights) then
1348 if (bc_s%beg == bc_riemann_extrap) then
1349 d_cbr_x(1:2, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1350 d_cbl_x(1:2, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1351 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:, 1) = d_cbr_x(:, 1)/sum(d_cbr_x(:, 1))
1352 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:, 1) = d_cbl_x(:, 1)/sum(d_cbl_x(:, 1))
1353 end if
1354
1355 if (bc_s%end == bc_riemann_extrap) then
1356 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:, s - 1) = d_cbr_x(:, s - 1)/sum(d_cbr_x(:, s - 1))
1357 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:, s - 1) = d_cbl_x(:, s - 1)/sum(d_cbl_x(:, s - 1))
1358 d_cbr_x(0:1, s) = 0._wp; d_cbr_x(2, s) = 1._wp
1359 d_cbl_x(0:1, s) = 0._wp; d_cbl_x(2, s) = 1._wp
1360 end if
1361 end if
1362
1363 else ! WENO7
1364
1365 if (.not. teno) then
1366
1367 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1368
1369 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
1370 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
1371 ! Equation 2.61: Smoothness Indicators (beta_coef)
1372 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
1373 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
1374 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1375 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
1376 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
1377 ! using the cell value differences (dvd) instead of the values themselves.
1378 ! While the polynomial coefficients sum to 1, the derivative of 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1379
1380 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1381 d_cbr_x(0, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
1382 d_cbr_x(1, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
1383 d_cbr_x(2, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
1384 d_cbr_x(3, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
1385
1386 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1387 d_cbl_x(0, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
1388 d_cbl_x(1, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
1389 d_cbl_x(2, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
1390 d_cbl_x(3, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
1391 ! Note: Left has the reversed order of both points and coefficients compared to the right
1392
1393 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1394 poly_coef_cbr_x(i + 1, 0, 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1395 poly_coef_cbr_x(i + 1, 0, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1396 poly_coef_cbr_x(i + 1, 0, 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1397
1398 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1399 poly_coef_cbr_x(i + 1, 1, 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1400 poly_coef_cbr_x(i + 1, 1, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1401 poly_coef_cbr_x(i + 1, 1, 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1402
1403 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1404 poly_coef_cbr_x(i + 1, 2, 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1405 poly_coef_cbr_x(i + 1, 2, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1406 poly_coef_cbr_x(i + 1, 2, 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1407
1408 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1409 poly_coef_cbr_x(i + 1, 3, 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1410 poly_coef_cbr_x(i + 1, 3, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1411 poly_coef_cbr_x(i + 1, 3, 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1412
1413 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1414 poly_coef_cbl_x(i + 1, 3, 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1415 poly_coef_cbl_x(i + 1, 3, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1416 poly_coef_cbl_x(i + 1, 3, 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1417
1418 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1419 poly_coef_cbl_x(i + 1, 2, 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1420 poly_coef_cbl_x(i + 1, 2, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1421 poly_coef_cbl_x(i + 1, 2, 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1422
1423 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1424 poly_coef_cbl_x(i + 1, 1, 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1425 poly_coef_cbl_x(i + 1, 1, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1426 poly_coef_cbl_x(i + 1, 1, 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1427
1428 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1429 poly_coef_cbl_x(i + 1, 0, 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1430 poly_coef_cbl_x(i + 1, 0, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1431 poly_coef_cbl_x(i + 1, 0, 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1432
1433 poly_coef_cbl_x(i + 1, :, :) = -poly_coef_cbl_x(i + 1, :, :)
1434 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1435
1436 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1437 beta_coef_x(i + 1, 3, 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2)**3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) & !&
1438 + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1)*y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2)**3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 & !&
1439 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3)*y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4)**2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1440 beta_coef_x(i + 1, 3, 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) + 535*y(1)**2*y(2)*y(4)**2 & !&
1441 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1)*y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1)*y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 & !&
1442 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1)*y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3)**3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4)**4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 & !&
1443 + 210*y(2)**3*y(3)*y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2)*y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2)*y(4)**4 & !&
1444 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3)**2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1445 beta_coef_x(i + 1, 3, 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3)*y(4)**2 & !&
1446 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1)*y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 + 105*y(1)*y(4)**3)) & !&
1447 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1448 beta_coef_x(i + 1, 3, 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 & !&
1449 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1)**2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) & !&
1450 + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1)**2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 & !&
1451 + 1800*y(1)*y(2)**2*y(4)**3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3)**2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3)**5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4)**3 & !&
1452 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3)**4 + 540*y(2)**2*y(3)**3*y(4) & !&
1453 + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3)*y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) & !&
1454 + 1395*y(3)**4*y(4)**2 + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1455 beta_coef_x(i + 1, 3, 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1)**2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1)**2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) & !&
1456 + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2)*y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4)**3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 & !&
1457 + 30*y(2)**3*y(3)*y(4) + 300*y(2)**3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3)*y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 & !&
1458 + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1459 beta_coef_x(i + 1, 3, 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4)**3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 + 831*y(4)**4))/(5*(y(1) & !&
1460 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1461
1462 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1463 beta_coef_x(i + 1, 2, 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3)**3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 + 831*y(3)**4))/(5*(y(3) & !&
1464 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1465 beta_coef_x(i + 1, 2, 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 285*y(1)**2*y(3)**3 & !&
1466 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 & !&
1467 - 1847*y(1)*y(3)**4 + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2)**4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 & !&
1468 - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1469 beta_coef_x(i + 1, 2, 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2)*y(3)**2*y(4) & !&
1470 + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1471 beta_coef_x(i + 1, 2, 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 & !&
1472 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1)**2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) & !&
1473 - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 & !&
1474 + 90*y(1)*y(2)**2*y(4)**3 + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4)**2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 & !&
1475 + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3)*y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) + 25*y(2)**2*y(3)**2*y(4)**2 & !&
1476 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3)**5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) & !&
1477 /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1478 beta_coef_x(i + 1, 2, 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1)*y(2)*y(3)**3 & !&
1479 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1)*y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2)**3*y(4)**2 + 400*y(2)**2*y(3)**3 & !&
1480 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3)**4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3)) & !&
1481 /(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1482 beta_coef_x(i + 1, 2, 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1483
1484 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1485 beta_coef_x(i + 1, 1, 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1486 beta_coef_x(i + 1, 1, 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1)**2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1)**2*y(2)*y(3)*y(4) & !&
1487 + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2)**3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2)**2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 & !&
1488 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2)**2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2)) & !&
1489 /(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1490 beta_coef_x(i + 1, 1, 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2)*y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) & !&
1491 + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1492 beta_coef_x(i + 1, 1, 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1)**3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1)**3*y(2)*y(3)**2 & !&
1493 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1)**3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) + 25*y(1)**2*y(2)**2*y(3)**2 & !&
1494 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2)**2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1)**2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 & !&
1495 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4)**2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) & !&
1496 + 125*y(1)*y(2)**2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) & !&
1497 + 4224*y(2)**4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4)**3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4)**2 & !&
1498 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1499 beta_coef_x(i + 1, 1, 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1)**2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 - 1452*y(1)*y(2)**4 & !&
1500 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4)**2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4)**2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 & !&
1501 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3)**2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2)**4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) & !&
1502 - 465*y(2)**2*y(3)*y(4)**2 - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3)**2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1503 beta_coef_x(i + 1, 1, 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2)**2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) & !&
1504 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1505
1506 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1507 beta_coef_x(i + 1, 0, 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1)**2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) + 5*y(2)**2*y(3)**2))/(5*(y(3) & !&
1508 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1509 beta_coef_x(i + 1, 0, 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1)**3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4)**2 + 1060*y(1)**2*y(2)**3 & !&
1510 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4)**2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) & !&
1511 + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2)**2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 & !&
1512 + 60*y(2)**3*y(3)*y(4) + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2)**2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1513 beta_coef_x(i + 1, 0, 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4)*y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2)**2*y(3) + 35*y(4)*y(1)*y(2)**2 & !&
1514 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4)*y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4)*y(2)*y(3)**2)) & !&
1515 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1516 beta_coef_x(i + 1, 0, 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1)**5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 + 2565*y(1)**3*y(2)**3 & !&
1517 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2)*y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 & !&
1518 + 4380*y(1)**2*y(2)**3*y(3) + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2)**2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 & !&
1519 + 415*y(1)**2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1)**2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1)*y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3)**2 & !&
1520 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 & !&
1521 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 & !&
1522 + 45*y(2)**2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2)**2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1523 beta_coef_x(i + 1, 0, 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1)**3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4)**2 + 1800*y(1)**2*y(2)**3 & !&
1524 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2)**2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1)**2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1)**2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 & !&
1525 + 720*y(1)*y(2)**3*y(3) + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 & !&
1526 + 30*y(1)*y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3)*y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) + 130*y(2)**2*y(3)*y(4)**2 & !&
1527 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3)**3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1528 beta_coef_x(i + 1, 0, 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1)**3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1)*y(2)**3 + 270*y(1)*y(2)**2*y(3) & !&
1529 + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3)**2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) & !&
1530 + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3)**3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1531
1532 end do
1533
1534 else ! TENO (only supports uniform grid)
1535 ! (Fu, et al., 2016) Table 2 (for right flux)
1536 d_cbl_x(0, :) = 18._wp/35._wp
1537 d_cbl_x(1, :) = 3._wp/35._wp
1538 d_cbl_x(2, :) = 9._wp/35._wp
1539 d_cbl_x(3, :) = 1._wp/35._wp
1540 d_cbl_x(4, :) = 4._wp/35._wp
1541
1542 d_cbr_x(0, :) = 18._wp/35._wp
1543 d_cbr_x(1, :) = 9._wp/35._wp
1544 d_cbr_x(2, :) = 3._wp/35._wp
1545 d_cbr_x(3, :) = 4._wp/35._wp
1546 d_cbr_x(4, :) = 1._wp/35._wp
1547
1548 end if
1549 end if
1550
1551 end if
1552# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1553 ! Computing WENO3 Coefficients
1554 if (weno_dir == 2) then
1555 if (weno_order == 3) then
1556 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1557
1558 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1559 (s_cb(i) - s_cb(i + 2))
1560 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1561 (s_cb(i - 1) - s_cb(i + 1))
1562
1563 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1564 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1565
1566 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1567 (s_cb(i - 1) - s_cb(i + 2))
1568 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1569 (s_cb(i - 1) - s_cb(i + 2))
1570
1571 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1572 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1573
1574 beta_coef_y(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1575 (s_cb(i) - s_cb(i + 2))**2._wp
1576 beta_coef_y(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1577 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1578
1579 end do
1580
1581 ! Modifying the ideal weights coefficients in the neighborhood
1582 ! of beginning and end Riemann state extrapolation BC to avoid
1583 ! any contributions from outside of the physical domain during
1584 ! the WENO reconstruction
1585 if (null_weights) then
1586 if (bc_s%beg == bc_riemann_extrap) then
1587 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1588 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1589 end if
1590
1591 if (bc_s%end == bc_riemann_extrap) then
1592 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1593 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1594 end if
1595 end if
1596 ! END: Computing WENO3 Coefficients
1597
1598 ! Computing WENO5 Coefficients
1599 elseif (weno_order == 5) then
1600
1601 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1602
1603 poly_coef_cbr_y(i + 1, 0, 0) = &
1604 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1605 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1606 poly_coef_cbr_y(i + 1, 1, 0) = &
1607 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1608 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1609 poly_coef_cbr_y(i + 1, 1, 1) = &
1610 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1611 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1612 poly_coef_cbr_y(i + 1, 2, 1) = &
1613 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1614 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1615 poly_coef_cbl_y(i + 1, 0, 0) = &
1616 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1617 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1618 poly_coef_cbl_y(i + 1, 1, 0) = &
1619 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
1620 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
1621 poly_coef_cbl_y(i + 1, 1, 1) = &
1622 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1623 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1624 poly_coef_cbl_y(i + 1, 2, 1) = &
1625 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
1626 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1627
1628 poly_coef_cbr_y(i + 1, 0, 1) = &
1629 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
1630 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1631 ((s_cb(i) - s_cb(i + 1)))
1632 poly_coef_cbr_y(i + 1, 2, 0) = &
1633 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1634 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
1635 ((s_cb(i + 1) - s_cb(i)))
1636 poly_coef_cbl_y(i + 1, 0, 1) = &
1637 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
1638 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1639 ((s_cb(i + 1) - s_cb(i)))
1640 poly_coef_cbl_y(i + 1, 2, 0) = &
1641 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1642 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
1643 ((s_cb(i) - s_cb(i + 1)))
1644
1645 d_cbr_y(0, i + 1) = &
1646 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1647 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1648 d_cbr_y(2, i + 1) = &
1649 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
1650 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1651 d_cbl_y(0, i + 1) = &
1652 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
1653 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1654 d_cbl_y(2, i + 1) = &
1655 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
1656 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1657
1658 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1659 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1660
1661 beta_coef_y(i + 1, 0, 0) = &
1662 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1663 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1664 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
1665 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1666
1667 beta_coef_y(i + 1, 0, 1) = &
1668 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1669 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
1670 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
1671 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
1672 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
1673 s_cb(i + 1)))
1674
1675 beta_coef_y(i + 1, 0, 2) = &
1676 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1677 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
1678 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
1679 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
1680 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1681
1682 beta_coef_y(i + 1, 1, 0) = &
1683 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1684 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1685 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
1686 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1687
1688 beta_coef_y(i + 1, 1, 1) = &
1689 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
1690 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
1691 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
1692 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
1693 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
1694 s_cb(i)))
1695
1696 beta_coef_y(i + 1, 1, 2) = &
1697 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1698 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1699 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
1700 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1701 s_cb(i + 2))**2._wp)
1702
1703 beta_coef_y(i + 1, 2, 0) = &
1704 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
1705 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
1706 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
1707 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
1708 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1709 s_cb(i + 1))**2._wp)
1710
1711 beta_coef_y(i + 1, 2, 1) = &
1712 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1713 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
1714 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
1715 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
1716 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
1717 s_cb(i - 1)))
1718
1719 beta_coef_y(i + 1, 2, 2) = &
1720 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1721 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1722 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
1723 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1724
1725 end do
1726
1727 ! Modifying the ideal weights coefficients in the neighborhood
1728 ! of beginning and end Riemann state extrapolation BC to avoid
1729 ! any contributions from outside of the physical domain during
1730 ! the WENO reconstruction
1731 if (null_weights) then
1732 if (bc_s%beg == bc_riemann_extrap) then
1733 d_cbr_y(1:2, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1734 d_cbl_y(1:2, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1735 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:, 1) = d_cbr_y(:, 1)/sum(d_cbr_y(:, 1))
1736 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:, 1) = d_cbl_y(:, 1)/sum(d_cbl_y(:, 1))
1737 end if
1738
1739 if (bc_s%end == bc_riemann_extrap) then
1740 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:, s - 1) = d_cbr_y(:, s - 1)/sum(d_cbr_y(:, s - 1))
1741 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:, s - 1) = d_cbl_y(:, s - 1)/sum(d_cbl_y(:, s - 1))
1742 d_cbr_y(0:1, s) = 0._wp; d_cbr_y(2, s) = 1._wp
1743 d_cbl_y(0:1, s) = 0._wp; d_cbl_y(2, s) = 1._wp
1744 end if
1745 end if
1746
1747 else ! WENO7
1748
1749 if (.not. teno) then
1750
1751 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1752
1753 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
1754 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
1755 ! Equation 2.61: Smoothness Indicators (beta_coef)
1756 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
1757 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
1758 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1759 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
1760 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
1761 ! using the cell value differences (dvd) instead of the values themselves.
1762 ! While the polynomial coefficients sum to 1, the derivative of 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1763
1764 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1765 d_cbr_y(0, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
1766 d_cbr_y(1, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
1767 d_cbr_y(2, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
1768 d_cbr_y(3, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
1769
1770 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1771 d_cbl_y(0, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
1772 d_cbl_y(1, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
1773 d_cbl_y(2, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
1774 d_cbl_y(3, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
1775 ! Note: Left has the reversed order of both points and coefficients compared to the right
1776
1777 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1778 poly_coef_cbr_y(i + 1, 0, 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1779 poly_coef_cbr_y(i + 1, 0, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1780 poly_coef_cbr_y(i + 1, 0, 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1781
1782 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1783 poly_coef_cbr_y(i + 1, 1, 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1784 poly_coef_cbr_y(i + 1, 1, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1785 poly_coef_cbr_y(i + 1, 1, 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1786
1787 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1788 poly_coef_cbr_y(i + 1, 2, 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1789 poly_coef_cbr_y(i + 1, 2, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1790 poly_coef_cbr_y(i + 1, 2, 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1791
1792 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1793 poly_coef_cbr_y(i + 1, 3, 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1794 poly_coef_cbr_y(i + 1, 3, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1795 poly_coef_cbr_y(i + 1, 3, 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1796
1797 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1798 poly_coef_cbl_y(i + 1, 3, 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1799 poly_coef_cbl_y(i + 1, 3, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1800 poly_coef_cbl_y(i + 1, 3, 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1801
1802 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1803 poly_coef_cbl_y(i + 1, 2, 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1804 poly_coef_cbl_y(i + 1, 2, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1805 poly_coef_cbl_y(i + 1, 2, 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1806
1807 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1808 poly_coef_cbl_y(i + 1, 1, 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1809 poly_coef_cbl_y(i + 1, 1, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1810 poly_coef_cbl_y(i + 1, 1, 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1811
1812 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1813 poly_coef_cbl_y(i + 1, 0, 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1814 poly_coef_cbl_y(i + 1, 0, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
1815 poly_coef_cbl_y(i + 1, 0, 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
1816
1817 poly_coef_cbl_y(i + 1, :, :) = -poly_coef_cbl_y(i + 1, :, :)
1818 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1819
1820 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1821 beta_coef_y(i + 1, 3, 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2)**3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) & !&
1822 + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1)*y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2)**3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 & !&
1823 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3)*y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4)**2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1824 beta_coef_y(i + 1, 3, 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) + 535*y(1)**2*y(2)*y(4)**2 & !&
1825 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1)*y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1)*y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 & !&
1826 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1)*y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3)**3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4)**4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 & !&
1827 + 210*y(2)**3*y(3)*y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2)*y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2)*y(4)**4 & !&
1828 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3)**2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1829 beta_coef_y(i + 1, 3, 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3)*y(4)**2 & !&
1830 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1)*y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 + 105*y(1)*y(4)**3)) & !&
1831 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1832 beta_coef_y(i + 1, 3, 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 & !&
1833 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1)**2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) & !&
1834 + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1)**2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 & !&
1835 + 1800*y(1)*y(2)**2*y(4)**3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3)**2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3)**5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4)**3 & !&
1836 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3)**4 + 540*y(2)**2*y(3)**3*y(4) & !&
1837 + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3)*y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) & !&
1838 + 1395*y(3)**4*y(4)**2 + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1839 beta_coef_y(i + 1, 3, 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1)**2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1)**2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) & !&
1840 + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2)*y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4)**3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 & !&
1841 + 30*y(2)**3*y(3)*y(4) + 300*y(2)**3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3)*y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 & !&
1842 + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1843 beta_coef_y(i + 1, 3, 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4)**3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 + 831*y(4)**4))/(5*(y(1) & !&
1844 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1845
1846 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1847 beta_coef_y(i + 1, 2, 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3)**3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 + 831*y(3)**4))/(5*(y(3) & !&
1848 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1849 beta_coef_y(i + 1, 2, 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 285*y(1)**2*y(3)**3 & !&
1850 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 & !&
1851 - 1847*y(1)*y(3)**4 + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2)**4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 & !&
1852 - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1853 beta_coef_y(i + 1, 2, 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2)*y(3)**2*y(4) & !&
1854 + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1855 beta_coef_y(i + 1, 2, 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 & !&
1856 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1)**2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) & !&
1857 - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 & !&
1858 + 90*y(1)*y(2)**2*y(4)**3 + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4)**2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 & !&
1859 + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3)*y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) + 25*y(2)**2*y(3)**2*y(4)**2 & !&
1860 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3)**5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) & !&
1861 /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1862 beta_coef_y(i + 1, 2, 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1)*y(2)*y(3)**3 & !&
1863 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1)*y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2)**3*y(4)**2 + 400*y(2)**2*y(3)**3 & !&
1864 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3)**4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3)) & !&
1865 /(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1866 beta_coef_y(i + 1, 2, 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1867
1868 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1869 beta_coef_y(i + 1, 1, 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1870 beta_coef_y(i + 1, 1, 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1)**2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1)**2*y(2)*y(3)*y(4) & !&
1871 + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2)**3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2)**2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 & !&
1872 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2)**2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2)) & !&
1873 /(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1874 beta_coef_y(i + 1, 1, 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2)*y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) & !&
1875 + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1876 beta_coef_y(i + 1, 1, 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1)**3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1)**3*y(2)*y(3)**2 & !&
1877 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1)**3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) + 25*y(1)**2*y(2)**2*y(3)**2 & !&
1878 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2)**2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1)**2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 & !&
1879 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4)**2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) & !&
1880 + 125*y(1)*y(2)**2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) & !&
1881 + 4224*y(2)**4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4)**3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4)**2 & !&
1882 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1883 beta_coef_y(i + 1, 1, 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1)**2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 - 1452*y(1)*y(2)**4 & !&
1884 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4)**2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4)**2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 & !&
1885 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3)**2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2)**4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) & !&
1886 - 465*y(2)**2*y(3)*y(4)**2 - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3)**2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1887 beta_coef_y(i + 1, 1, 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2)**2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) & !&
1888 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1889
1890 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1891 beta_coef_y(i + 1, 0, 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1)**2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) + 5*y(2)**2*y(3)**2))/(5*(y(3) & !&
1892 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1893 beta_coef_y(i + 1, 0, 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1)**3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4)**2 + 1060*y(1)**2*y(2)**3 & !&
1894 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4)**2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) & !&
1895 + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2)**2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 & !&
1896 + 60*y(2)**3*y(3)*y(4) + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2)**2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1897 beta_coef_y(i + 1, 0, 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4)*y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2)**2*y(3) + 35*y(4)*y(1)*y(2)**2 & !&
1898 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4)*y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4)*y(2)*y(3)**2)) & !&
1899 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1900 beta_coef_y(i + 1, 0, 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1)**5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 + 2565*y(1)**3*y(2)**3 & !&
1901 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2)*y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 & !&
1902 + 4380*y(1)**2*y(2)**3*y(3) + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2)**2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 & !&
1903 + 415*y(1)**2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1)**2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1)*y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3)**2 & !&
1904 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 & !&
1905 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 & !&
1906 + 45*y(2)**2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2)**2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1907 beta_coef_y(i + 1, 0, 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1)**3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4)**2 + 1800*y(1)**2*y(2)**3 & !&
1908 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2)**2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1)**2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1)**2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 & !&
1909 + 720*y(1)*y(2)**3*y(3) + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 & !&
1910 + 30*y(1)*y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3)*y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) + 130*y(2)**2*y(3)*y(4)**2 & !&
1911 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3)**3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
1912 beta_coef_y(i + 1, 0, 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1)**3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1)*y(2)**3 + 270*y(1)*y(2)**2*y(3) & !&
1913 + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3)**2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) & !&
1914 + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3)**3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1915
1916 end do
1917
1918 else ! TENO (only supports uniform grid)
1919 ! (Fu, et al., 2016) Table 2 (for right flux)
1920 d_cbl_y(0, :) = 18._wp/35._wp
1921 d_cbl_y(1, :) = 3._wp/35._wp
1922 d_cbl_y(2, :) = 9._wp/35._wp
1923 d_cbl_y(3, :) = 1._wp/35._wp
1924 d_cbl_y(4, :) = 4._wp/35._wp
1925
1926 d_cbr_y(0, :) = 18._wp/35._wp
1927 d_cbr_y(1, :) = 9._wp/35._wp
1928 d_cbr_y(2, :) = 3._wp/35._wp
1929 d_cbr_y(3, :) = 4._wp/35._wp
1930 d_cbr_y(4, :) = 1._wp/35._wp
1931
1932 end if
1933 end if
1934
1935 end if
1936# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1937 ! Computing WENO3 Coefficients
1938 if (weno_dir == 3) then
1939 if (weno_order == 3) then
1940 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1941
1942 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1943 (s_cb(i) - s_cb(i + 2))
1944 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1945 (s_cb(i - 1) - s_cb(i + 1))
1946
1947 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
1948 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
1949
1950 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1951 (s_cb(i - 1) - s_cb(i + 2))
1952 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1953 (s_cb(i - 1) - s_cb(i + 2))
1954
1955 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
1956 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
1957
1958 beta_coef_z(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1959 (s_cb(i) - s_cb(i + 2))**2._wp
1960 beta_coef_z(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1961 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1962
1963 end do
1964
1965 ! Modifying the ideal weights coefficients in the neighborhood
1966 ! of beginning and end Riemann state extrapolation BC to avoid
1967 ! any contributions from outside of the physical domain during
1968 ! the WENO reconstruction
1969 if (null_weights) then
1970 if (bc_s%beg == bc_riemann_extrap) then
1971 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
1972 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
1973 end if
1974
1975 if (bc_s%end == bc_riemann_extrap) then
1976 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
1977 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
1978 end if
1979 end if
1980 ! END: Computing WENO3 Coefficients
1981
1982 ! Computing WENO5 Coefficients
1983 elseif (weno_order == 5) then
1984
1985 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1986
1987 poly_coef_cbr_z(i + 1, 0, 0) = &
1988 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1989 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1990 poly_coef_cbr_z(i + 1, 1, 0) = &
1991 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1992 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1993 poly_coef_cbr_z(i + 1, 1, 1) = &
1994 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1995 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1996 poly_coef_cbr_z(i + 1, 2, 1) = &
1997 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1998 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1999 poly_coef_cbl_z(i + 1, 0, 0) = &
2000 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
2001 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2002 poly_coef_cbl_z(i + 1, 1, 0) = &
2003 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
2004 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
2005 poly_coef_cbl_z(i + 1, 1, 1) = &
2006 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
2007 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2008 poly_coef_cbl_z(i + 1, 2, 1) = &
2009 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
2010 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2011
2012 poly_coef_cbr_z(i + 1, 0, 1) = &
2013 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
2014 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
2015 ((s_cb(i) - s_cb(i + 1)))
2016 poly_coef_cbr_z(i + 1, 2, 0) = &
2017 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
2018 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
2019 ((s_cb(i + 1) - s_cb(i)))
2020 poly_coef_cbl_z(i + 1, 0, 1) = &
2021 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
2022 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
2023 ((s_cb(i + 1) - s_cb(i)))
2024 poly_coef_cbl_z(i + 1, 2, 0) = &
2025 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
2026 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
2027 ((s_cb(i) - s_cb(i + 1)))
2028
2029 d_cbr_z(0, i + 1) = &
2030 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
2031 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2032 d_cbr_z(2, i + 1) = &
2033 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
2034 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2035 d_cbl_z(0, i + 1) = &
2036 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
2037 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2038 d_cbl_z(2, i + 1) = &
2039 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
2040 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2041
2042 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2043 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2044
2045 beta_coef_z(i + 1, 0, 0) = &
2046 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2047 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
2048 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
2049 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2050
2051 beta_coef_z(i + 1, 0, 1) = &
2052 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
2053 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
2054 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
2055 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
2056 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
2057 s_cb(i + 1)))
2058
2059 beta_coef_z(i + 1, 0, 2) = &
2060 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2061 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
2062 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
2063 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
2064 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2065
2066 beta_coef_z(i + 1, 1, 0) = &
2067 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2068 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
2069 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
2070 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2071
2072 beta_coef_z(i + 1, 1, 1) = &
2073 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
2074 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
2075 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
2076 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
2077 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
2078 s_cb(i)))
2079
2080 beta_coef_z(i + 1, 1, 2) = &
2081 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2082 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
2083 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
2084 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
2085 s_cb(i + 2))**2._wp)
2086
2087 beta_coef_z(i + 1, 2, 0) = &
2088 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
2089 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
2090 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
2091 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
2092 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
2093 s_cb(i + 1))**2._wp)
2094
2095 beta_coef_z(i + 1, 2, 1) = &
2096 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
2097 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
2098 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
2099 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
2100 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
2101 s_cb(i - 1)))
2102
2103 beta_coef_z(i + 1, 2, 2) = &
2104 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2105 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
2106 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
2107 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2108
2109 end do
2110
2111 ! Modifying the ideal weights coefficients in the neighborhood
2112 ! of beginning and end Riemann state extrapolation BC to avoid
2113 ! any contributions from outside of the physical domain during
2114 ! the WENO reconstruction
2115 if (null_weights) then
2116 if (bc_s%beg == bc_riemann_extrap) then
2117 d_cbr_z(1:2, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2118 d_cbl_z(1:2, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2119 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:, 1) = d_cbr_z(:, 1)/sum(d_cbr_z(:, 1))
2120 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:, 1) = d_cbl_z(:, 1)/sum(d_cbl_z(:, 1))
2121 end if
2122
2123 if (bc_s%end == bc_riemann_extrap) then
2124 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:, s - 1) = d_cbr_z(:, s - 1)/sum(d_cbr_z(:, s - 1))
2125 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:, s - 1) = d_cbl_z(:, s - 1)/sum(d_cbl_z(:, s - 1))
2126 d_cbr_z(0:1, s) = 0._wp; d_cbr_z(2, s) = 1._wp
2127 d_cbl_z(0:1, s) = 0._wp; d_cbl_z(2, s) = 1._wp
2128 end if
2129 end if
2130
2131 else ! WENO7
2132
2133 if (.not. teno) then
2134
2135 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2136
2137 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
2138 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
2139 ! Equation 2.61: Smoothness Indicators (beta_coef)
2140 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
2141 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
2142 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2143 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
2144 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
2145 ! using the cell value differences (dvd) instead of the values themselves.
2146 ! While the polynomial coefficients sum to 1, the derivative of 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2147
2148 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2149 d_cbr_z(0, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
2150 d_cbr_z(1, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
2151 d_cbr_z(2, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
2152 d_cbr_z(3, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
2153
2154 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2155 d_cbl_z(0, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8))*(w(3) - w(8))) !&
2156 d_cbl_z(1, i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2)*w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7)*w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))*(w(3) - w(8))) !&
2157 d_cbl_z(2, i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1)*w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7)*w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8))) !&
2158 d_cbl_z(3, i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))) !&
2159 ! Note: Left has the reversed order of both points and coefficients compared to the right
2160
2161 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2162 poly_coef_cbr_z(i + 1, 0, 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2163 poly_coef_cbr_z(i + 1, 0, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2164 poly_coef_cbr_z(i + 1, 0, 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2165
2166 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2167 poly_coef_cbr_z(i + 1, 1, 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2168 poly_coef_cbr_z(i + 1, 1, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2169 poly_coef_cbr_z(i + 1, 1, 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2170
2171 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2172 poly_coef_cbr_z(i + 1, 2, 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2173 poly_coef_cbr_z(i + 1, 2, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2174 poly_coef_cbr_z(i + 1, 2, 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2175
2176 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2177 poly_coef_cbr_z(i + 1, 3, 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2178 poly_coef_cbr_z(i + 1, 3, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2179 poly_coef_cbr_z(i + 1, 3, 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2180
2181 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2182 poly_coef_cbl_z(i + 1, 3, 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2183 poly_coef_cbl_z(i + 1, 3, 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2184 poly_coef_cbl_z(i + 1, 3, 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2185
2186 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2187 poly_coef_cbl_z(i + 1, 2, 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2188 poly_coef_cbl_z(i + 1, 2, 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2189 poly_coef_cbl_z(i + 1, 2, 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2190
2191 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2192 poly_coef_cbl_z(i + 1, 1, 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2193 poly_coef_cbl_z(i + 1, 1, 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2194 poly_coef_cbl_z(i + 1, 1, 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2195
2196 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2197 poly_coef_cbl_z(i + 1, 0, 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2198 poly_coef_cbl_z(i + 1, 0, 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2))/((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) !&
2199 poly_coef_cbl_z(i + 1, 0, 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) !&
2200
2201 poly_coef_cbl_z(i + 1, :, :) = -poly_coef_cbl_z(i + 1, :, :)
2202 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2203
2204 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2205 beta_coef_z(i + 1, 3, 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2)**3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) & !&
2206 + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1)*y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2)**3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 & !&
2207 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3)*y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4)**2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2208 beta_coef_z(i + 1, 3, 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) + 535*y(1)**2*y(2)*y(4)**2 & !&
2209 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1)*y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1)*y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 & !&
2210 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1)*y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3)**3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4)**4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 & !&
2211 + 210*y(2)**3*y(3)*y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2)*y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2)*y(4)**4 & !&
2212 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3)**2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2213 beta_coef_z(i + 1, 3, 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3)*y(4)**2 & !&
2214 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1)*y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 + 105*y(1)*y(4)**3)) & !&
2215 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2216 beta_coef_z(i + 1, 3, 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 & !&
2217 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1)**2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) & !&
2218 + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1)**2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 & !&
2219 + 1800*y(1)*y(2)**2*y(4)**3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3)**2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3)**5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4)**3 & !&
2220 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3)**4 + 540*y(2)**2*y(3)**3*y(4) & !&
2221 + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3)*y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) & !&
2222 + 1395*y(3)**4*y(4)**2 + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2223 beta_coef_z(i + 1, 3, 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1)**2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1)**2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) & !&
2224 + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2)*y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4)**3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 & !&
2225 + 30*y(2)**3*y(3)*y(4) + 300*y(2)**3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3)*y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 & !&
2226 + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2227 beta_coef_z(i + 1, 3, 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4)**3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 + 831*y(4)**4))/(5*(y(1) & !&
2228 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2229
2230 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2231 beta_coef_z(i + 1, 2, 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3)**3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 + 831*y(3)**4))/(5*(y(3) & !&
2232 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2233 beta_coef_z(i + 1, 2, 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 285*y(1)**2*y(3)**3 & !&
2234 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 & !&
2235 - 1847*y(1)*y(3)**4 + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2)**4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 & !&
2236 - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2237 beta_coef_z(i + 1, 2, 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2)*y(3)**2*y(4) & !&
2238 + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2239 beta_coef_z(i + 1, 2, 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 & !&
2240 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1)**2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) & !&
2241 - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2)**3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 & !&
2242 + 90*y(1)*y(2)**2*y(4)**3 + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4)**2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 & !&
2243 + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3)*y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) + 25*y(2)**2*y(3)**2*y(4)**2 & !&
2244 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3)**5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) & !&
2245 /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2246 beta_coef_z(i + 1, 2, 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1)*y(2)*y(3)**3 & !&
2247 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1)*y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2)**3*y(4)**2 + 400*y(2)**2*y(3)**3 & !&
2248 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3)**4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3)) & !&
2249 /(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2250 beta_coef_z(i + 1, 2, 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2251
2252 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2253 beta_coef_z(i + 1, 1, 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2254 beta_coef_z(i + 1, 1, 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1)**2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1)**2*y(2)*y(3)*y(4) & !&
2255 + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2)**3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2)**2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 & !&
2256 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2)**2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2)) & !&
2257 /(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2258 beta_coef_z(i + 1, 1, 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2)*y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) & !&
2259 + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2260 beta_coef_z(i + 1, 1, 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1)**3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1)**3*y(2)*y(3)**2 & !&
2261 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1)**3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4)**3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) + 25*y(1)**2*y(2)**2*y(3)**2 & !&
2262 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2)**2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1)**2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 & !&
2263 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4)**2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) & !&
2264 + 125*y(1)*y(2)**2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) & !&
2265 + 4224*y(2)**4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4)**3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4)**2 & !&
2266 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2267 beta_coef_z(i + 1, 1, 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1)**2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 - 1452*y(1)*y(2)**4 & !&
2268 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4)**2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4)**2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 & !&
2269 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3)**2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2)**4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) & !&
2270 - 465*y(2)**2*y(3)*y(4)**2 - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3)**2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2271 beta_coef_z(i + 1, 1, 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2)**2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) & !&
2272 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2273
2274 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2275 beta_coef_z(i + 1, 0, 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1)**2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) + 5*y(2)**2*y(3)**2))/(5*(y(3) & !&
2276 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2277 beta_coef_z(i + 1, 0, 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1)**3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4)**2 + 1060*y(1)**2*y(2)**3 & !&
2278 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4)**2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) & !&
2279 + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2)**2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 & !&
2280 + 60*y(2)**3*y(3)*y(4) + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2)**2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2281 beta_coef_z(i + 1, 0, 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4)*y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2)**2*y(3) + 35*y(4)*y(1)*y(2)**2 & !&
2282 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4)*y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4)*y(2)*y(3)**2)) & !&
2283 /(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2284 beta_coef_z(i + 1, 0, 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1)**5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 + 2565*y(1)**3*y(2)**3 & !&
2285 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2)*y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3)*y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 & !&
2286 + 4380*y(1)**2*y(2)**3*y(3) + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2)**2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 & !&
2287 + 415*y(1)**2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1)**2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1)*y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3)**2 & !&
2288 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 & !&
2289 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 & !&
2290 + 45*y(2)**2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2)**2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2291 beta_coef_z(i + 1, 0, 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1)**3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4)**2 + 1800*y(1)**2*y(2)**3 & !&
2292 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2)**2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1)**2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1)**2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 & !&
2293 + 720*y(1)*y(2)**3*y(3) + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 & !&
2294 + 30*y(1)*y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3)*y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) + 130*y(2)**2*y(3)*y(4)**2 & !&
2295 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3)**3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) !&
2296 beta_coef_z(i + 1, 0, 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1)**3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1)*y(2)**3 + 270*y(1)*y(2)**2*y(3) & !&
2297 + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3)**2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) & !&
2298 + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3)**3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2299
2300 end do
2301
2302 else ! TENO (only supports uniform grid)
2303 ! (Fu, et al., 2016) Table 2 (for right flux)
2304 d_cbl_z(0, :) = 18._wp/35._wp
2305 d_cbl_z(1, :) = 3._wp/35._wp
2306 d_cbl_z(2, :) = 9._wp/35._wp
2307 d_cbl_z(3, :) = 1._wp/35._wp
2308 d_cbl_z(4, :) = 4._wp/35._wp
2309
2310 d_cbr_z(0, :) = 18._wp/35._wp
2311 d_cbr_z(1, :) = 9._wp/35._wp
2312 d_cbr_z(2, :) = 3._wp/35._wp
2313 d_cbr_z(3, :) = 4._wp/35._wp
2314 d_cbr_z(4, :) = 1._wp/35._wp
2315
2316 end if
2317 end if
2318
2319 end if
2320# 613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2321
2322 if (weno_dir == 1) then
2323
2324# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2325#if defined(MFC_OpenACC)
2326# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2327!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
2328# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2329#elif defined(MFC_OpenMP)
2330# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2331!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
2332# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2333#endif
2334 elseif (weno_dir == 2) then
2335
2336# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2337#if defined(MFC_OpenACC)
2338# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2339!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
2340# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2341#elif defined(MFC_OpenMP)
2342# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2343!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
2344# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2345#endif
2346 else
2347
2348# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2349#if defined(MFC_OpenACC)
2350# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2351!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
2352# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2353#elif defined(MFC_OpenMP)
2354# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2355!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
2356# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2357#endif
2358 end if
2359
2360 ! Nullifying WENO coefficients and cell-boundary locations pointers
2361
2362 nullify (s_cb)
2363
2364 end subroutine s_compute_weno_coefficients
2365
2366 !> @brief Performs WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
2367 subroutine s_weno(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, &
2368 weno_dir, &
2369 is1_weno_d, is2_weno_d, is3_weno_d)
2370
2371 type(scalar_field), dimension(1:), intent(in) :: v_vf
2372 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z
2373 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z
2374 integer, intent(in) :: weno_dir
2375 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
2376
2377# 647 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2378 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
2379 real(wp), dimension(0:weno_num_stencils) :: poly
2380 real(wp), dimension(0:weno_num_stencils) :: alpha
2381 real(wp), dimension(0:weno_num_stencils) :: omega
2382 real(wp), dimension(0:weno_num_stencils) :: beta
2383 real(wp), dimension(0:weno_num_stencils) :: delta
2384# 654 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2385 real(wp), dimension(-3:3) :: v ! temporary field value array for clarity (WENO7 only)
2386 real(wp) :: tau
2387
2388 integer :: i, j, k, l, q
2389
2390 is1_weno = is1_weno_d
2391 is2_weno = is2_weno_d
2392 is3_weno = is3_weno_d
2393
2394
2395# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2396#if defined(MFC_OpenACC)
2397# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2398!$acc update device(is1_weno, is2_weno, is3_weno)
2399# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2400#elif defined(MFC_OpenMP)
2401# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2402!$omp target update to(is1_weno, is2_weno, is3_weno)
2403# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2404#endif
2405
2406 if (weno_order /= 1 .or. dummy) then
2407 call s_initialize_weno(v_vf, &
2408 weno_dir)
2409 end if
2410
2411 if (weno_order == 1 .or. dummy) then
2412 if (weno_dir == 1) then
2413
2414# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2415
2416# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2417#if defined(MFC_OpenACC)
2418# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2419!$acc parallel loop collapse(4) gang vector default(present)
2420# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2421#elif defined(MFC_OpenMP)
2422# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2423
2424# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2425
2426# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2427
2428# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2429!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2430# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2431#endif
2432# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2433
2434 do i = 1, ubound(v_vf, 1)
2435 do l = is3_weno%beg, is3_weno%end
2436 do k = is2_weno%beg, is2_weno%end
2437 do j = is1_weno%beg, is1_weno%end
2438 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
2439 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
2440 end do
2441 end do
2442 end do
2443 end do
2444
2445# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2446
2447# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2448#if defined(MFC_OpenACC)
2449# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2450!$acc end parallel loop
2451# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2452#elif defined(MFC_OpenMP)
2453# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2454
2455# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2456
2457# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2458!$omp end target teams loop
2459# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2460#endif
2461# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2462
2463 else if (weno_dir == 2) then
2464
2465# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2466
2467# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2468#if defined(MFC_OpenACC)
2469# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2470!$acc parallel loop collapse(4) gang vector default(present)
2471# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2472#elif defined(MFC_OpenMP)
2473# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2474
2475# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2476
2477# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2478
2479# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2480!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2481# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2482#endif
2483# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2484
2485 do i = 1, ubound(v_vf, 1)
2486 do l = is3_weno%beg, is3_weno%end
2487 do k = is2_weno%beg, is2_weno%end
2488 do j = is1_weno%beg, is1_weno%end
2489 vl_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
2490 vr_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
2491 end do
2492 end do
2493 end do
2494 end do
2495
2496# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2497
2498# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2499#if defined(MFC_OpenACC)
2500# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2501!$acc end parallel loop
2502# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2503#elif defined(MFC_OpenMP)
2504# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2505
2506# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2507
2508# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2509!$omp end target teams loop
2510# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2511#endif
2512# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2513
2514 else if (weno_dir == 3) then
2515
2516# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2517
2518# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2519#if defined(MFC_OpenACC)
2520# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2521!$acc parallel loop collapse(4) gang vector default(present)
2522# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2523#elif defined(MFC_OpenMP)
2524# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2525
2526# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2527
2528# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2529
2530# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2531!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2532# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2533#endif
2534# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2535
2536 do i = 1, ubound(v_vf, 1)
2537 do l = is3_weno%beg, is3_weno%end
2538 do k = is2_weno%beg, is2_weno%end
2539 do j = is1_weno%beg, is1_weno%end
2540 vl_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
2541 vr_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
2542 end do
2543 end do
2544 end do
2545 end do
2546
2547# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2548
2549# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2550#if defined(MFC_OpenACC)
2551# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2552!$acc end parallel loop
2553# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2554#elif defined(MFC_OpenMP)
2555# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2556
2557# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2558
2559# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2560!$omp end target teams loop
2561# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2562#endif
2563# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2564
2565 end if
2566 end if
2567 if (weno_order == 3 .or. dummy) then
2568# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2569 if (weno_dir == 1) then
2570
2571# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2572
2573# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2574#if defined(MFC_OpenACC)
2575# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2576!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2577# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2578#elif defined(MFC_OpenMP)
2579# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2580
2581# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2582
2583# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2584
2585# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2586!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
2587# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2588#endif
2589# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2590
2591 do l = is3_weno%beg, is3_weno%end
2592 do k = is2_weno%beg, is2_weno%end
2593 do j = is1_weno%beg, is1_weno%end
2594 do i = 1, v_size
2595 ! reconstruct from left side
2596
2597 alpha(:) = 0._wp
2598 omega(:) = 0._wp
2599 beta(:) = weno_eps
2600
2601 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
2602 - v_rs_ws_x(j, k, l, i)
2603 dvd(-1) = v_rs_ws_x(j, k, l, i) &
2604 - v_rs_ws_x(j - 1, k, l, i)
2605
2606 poly(0) = v_rs_ws_x(j, k, l, i) &
2607 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
2608 poly(1) = v_rs_ws_x(j, k, l, i) &
2609 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
2610
2611 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) &
2612 + weno_eps
2613 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) &
2614 + weno_eps
2615
2616 if (wenojs) then
2617 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2618
2619 elseif (mapped_weno) then
2620 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2621 omega = alpha/sum(alpha)
2622 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, j)*(1._wp + d_cbl_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2623 *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_x(0:weno_num_stencils, j))))
2624
2625 elseif (wenoz) then
2626 ! Borges, et al. (2008)
2627
2628 tau = abs(beta(1) - beta(0))
2629 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2630
2631 end if
2632
2633 omega = alpha/sum(alpha)
2634
2635 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2636
2637 ! reconstruct from right side
2638
2639 poly(0) = v_rs_ws_x(j, k, l, i) &
2640 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
2641 poly(1) = v_rs_ws_x(j, k, l, i) &
2642 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
2643
2644 if (wenojs) then
2645 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2646
2647 elseif (mapped_weno) then
2648 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2649 omega = alpha/sum(alpha)
2650 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, j)*(1._wp + d_cbr_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2651 *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_x(0:weno_num_stencils, j))))
2652
2653 elseif (wenoz) then
2654
2655 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2656
2657 end if
2658
2659 omega = alpha/sum(alpha)
2660
2661 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2662
2663 end do
2664 end do
2665 end do
2666 end do
2667
2668# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2669
2670# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2671#if defined(MFC_OpenACC)
2672# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2673!$acc end parallel loop
2674# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2675#elif defined(MFC_OpenMP)
2676# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2677
2678# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2679
2680# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2681!$omp end target teams loop
2682# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2683#endif
2684# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2685
2686 end if
2687# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2688 if (weno_dir == 2) then
2689
2690# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2691
2692# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2693#if defined(MFC_OpenACC)
2694# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2695!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2696# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2697#elif defined(MFC_OpenMP)
2698# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2699
2700# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2701
2702# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2703
2704# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2705!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
2706# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2707#endif
2708# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2709
2710 do l = is3_weno%beg, is3_weno%end
2711 do k = is2_weno%beg, is2_weno%end
2712 do j = is1_weno%beg, is1_weno%end
2713 do i = 1, v_size
2714 ! reconstruct from left side
2715
2716 alpha(:) = 0._wp
2717 omega(:) = 0._wp
2718 beta(:) = weno_eps
2719
2720 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
2721 - v_rs_ws_y(j, k, l, i)
2722 dvd(-1) = v_rs_ws_y(j, k, l, i) &
2723 - v_rs_ws_y(j - 1, k, l, i)
2724
2725 poly(0) = v_rs_ws_y(j, k, l, i) &
2726 + poly_coef_cbl_y(j, 0, 0)*dvd(0)
2727 poly(1) = v_rs_ws_y(j, k, l, i) &
2728 + poly_coef_cbl_y(j, 1, 0)*dvd(-1)
2729
2730 beta(0) = beta_coef_y(j, 0, 0)*dvd(0)*dvd(0) &
2731 + weno_eps
2732 beta(1) = beta_coef_y(j, 1, 0)*dvd(-1)*dvd(-1) &
2733 + weno_eps
2734
2735 if (wenojs) then
2736 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2737
2738 elseif (mapped_weno) then
2739 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2740 omega = alpha/sum(alpha)
2741 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, j)*(1._wp + d_cbl_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2742 *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_y(0:weno_num_stencils, j))))
2743
2744 elseif (wenoz) then
2745 ! Borges, et al. (2008)
2746
2747 tau = abs(beta(1) - beta(0))
2748 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2749
2750 end if
2751
2752 omega = alpha/sum(alpha)
2753
2754 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2755
2756 ! reconstruct from right side
2757
2758 poly(0) = v_rs_ws_y(j, k, l, i) &
2759 + poly_coef_cbr_y(j, 0, 0)*dvd(0)
2760 poly(1) = v_rs_ws_y(j, k, l, i) &
2761 + poly_coef_cbr_y(j, 1, 0)*dvd(-1)
2762
2763 if (wenojs) then
2764 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2765
2766 elseif (mapped_weno) then
2767 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2768 omega = alpha/sum(alpha)
2769 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, j)*(1._wp + d_cbr_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2770 *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_y(0:weno_num_stencils, j))))
2771
2772 elseif (wenoz) then
2773
2774 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2775
2776 end if
2777
2778 omega = alpha/sum(alpha)
2779
2780 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2781
2782 end do
2783 end do
2784 end do
2785 end do
2786
2787# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2788
2789# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2790#if defined(MFC_OpenACC)
2791# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2792!$acc end parallel loop
2793# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2794#elif defined(MFC_OpenMP)
2795# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2796
2797# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2798
2799# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2800!$omp end target teams loop
2801# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2802#endif
2803# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2804
2805 end if
2806# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2807 if (weno_dir == 3) then
2808
2809# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2810
2811# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2812#if defined(MFC_OpenACC)
2813# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2814!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2815# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2816#elif defined(MFC_OpenMP)
2817# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2818
2819# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2820
2821# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2822
2823# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2824!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
2825# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2826#endif
2827# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2828
2829 do l = is3_weno%beg, is3_weno%end
2830 do k = is2_weno%beg, is2_weno%end
2831 do j = is1_weno%beg, is1_weno%end
2832 do i = 1, v_size
2833 ! reconstruct from left side
2834
2835 alpha(:) = 0._wp
2836 omega(:) = 0._wp
2837 beta(:) = weno_eps
2838
2839 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
2840 - v_rs_ws_z(j, k, l, i)
2841 dvd(-1) = v_rs_ws_z(j, k, l, i) &
2842 - v_rs_ws_z(j - 1, k, l, i)
2843
2844 poly(0) = v_rs_ws_z(j, k, l, i) &
2845 + poly_coef_cbl_z(j, 0, 0)*dvd(0)
2846 poly(1) = v_rs_ws_z(j, k, l, i) &
2847 + poly_coef_cbl_z(j, 1, 0)*dvd(-1)
2848
2849 beta(0) = beta_coef_z(j, 0, 0)*dvd(0)*dvd(0) &
2850 + weno_eps
2851 beta(1) = beta_coef_z(j, 1, 0)*dvd(-1)*dvd(-1) &
2852 + weno_eps
2853
2854 if (wenojs) then
2855 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2856
2857 elseif (mapped_weno) then
2858 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2859 omega = alpha/sum(alpha)
2860 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, j)*(1._wp + d_cbl_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2861 *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_z(0:weno_num_stencils, j))))
2862
2863 elseif (wenoz) then
2864 ! Borges, et al. (2008)
2865
2866 tau = abs(beta(1) - beta(0))
2867 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2868
2869 end if
2870
2871 omega = alpha/sum(alpha)
2872
2873 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2874
2875 ! reconstruct from right side
2876
2877 poly(0) = v_rs_ws_z(j, k, l, i) &
2878 + poly_coef_cbr_z(j, 0, 0)*dvd(0)
2879 poly(1) = v_rs_ws_z(j, k, l, i) &
2880 + poly_coef_cbr_z(j, 1, 0)*dvd(-1)
2881
2882 if (wenojs) then
2883 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2884
2885 elseif (mapped_weno) then
2886 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2887 omega = alpha/sum(alpha)
2888 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, j)*(1._wp + d_cbr_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
2889 *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_z(0:weno_num_stencils, j))))
2890
2891 elseif (wenoz) then
2892
2893 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2894
2895 end if
2896
2897 omega = alpha/sum(alpha)
2898
2899 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2900
2901 end do
2902 end do
2903 end do
2904 end do
2905
2906# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2907
2908# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2909#if defined(MFC_OpenACC)
2910# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2911!$acc end parallel loop
2912# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2913#elif defined(MFC_OpenMP)
2914# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2915
2916# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2917
2918# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2919!$omp end target teams loop
2920# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2921#endif
2922# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2923
2924 end if
2925# 795 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2926 end if
2927 if (weno_order == 5 .or. dummy) then
2928# 798 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2929# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2930 if (weno_dir == 1) then
2931
2932# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2933
2934# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2935#if defined(MFC_OpenACC)
2936# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2937!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
2938# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2939#elif defined(MFC_OpenMP)
2940# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2941
2942# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2943
2944# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2945
2946# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2947!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
2948# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2949#endif
2950# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2951
2952 do l = is3_weno%beg, is3_weno%end
2953 do k = is2_weno%beg, is2_weno%end
2954 do j = is1_weno%beg, is1_weno%end
2955
2956# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2957#if defined(MFC_OpenACC)
2958# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2959!$acc loop seq
2960# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2961#elif defined(MFC_OpenMP)
2962# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2963
2964# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2965#endif
2966 do i = 1, v_size
2967 ! reconstruct from left side
2968
2969 alpha(:) = 0._wp
2970 omega(:) = 0._wp
2971 delta(:) = 0._wp
2972 beta(:) = weno_eps
2973
2974 dvd(1) = v_rs_ws_x(j + 2, k, l, i) &
2975 - v_rs_ws_x(j + 1, k, l, i)
2976 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
2977 - v_rs_ws_x(j, k, l, i)
2978 dvd(-1) = v_rs_ws_x(j, k, l, i) &
2979 - v_rs_ws_x(j - 1, k, l, i)
2980 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) &
2981 - v_rs_ws_x(j - 2, k, l, i)
2982
2983 poly(0) = v_rs_ws_x(j, k, l, i) &
2984 + poly_coef_cbl_x(j, 0, 0)*dvd(1) &
2985 + poly_coef_cbl_x(j, 0, 1)*dvd(0)
2986 poly(1) = v_rs_ws_x(j, k, l, i) &
2987 + poly_coef_cbl_x(j, 1, 0)*dvd(0) &
2988 + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
2989 poly(2) = v_rs_ws_x(j, k, l, i) &
2990 + poly_coef_cbl_x(j, 2, 0)*dvd(-1) &
2991 + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
2992
2993 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) &
2994 + beta_coef_x(j, 0, 1)*dvd(1)*dvd(0) &
2995 + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) &
2996 + weno_eps
2997 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) &
2998 + beta_coef_x(j, 1, 1)*dvd(0)*dvd(-1) &
2999 + beta_coef_x(j, 1, 2)*dvd(-1)*dvd(-1) &
3000 + weno_eps
3001 beta(2) = beta_coef_x(j, 2, 0)*dvd(-1)*dvd(-1) &
3002 + beta_coef_x(j, 2, 1)*dvd(-1)*dvd(-2) &
3003 + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) &
3004 + weno_eps
3005
3006 if (wenojs) then
3007 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3008
3009 elseif (mapped_weno) then
3010 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3011 omega = alpha/sum(alpha)
3012 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, j)*(1._wp + d_cbl_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3013 *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_x(0:weno_num_stencils, j))))
3014
3015 elseif (wenoz) then
3016
3017 ! Borges, et al. (2008)
3018
3019 tau = abs(beta(2) - beta(0)) ! Equation 25
3020
3021# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3022#if defined(MFC_OpenACC)
3023# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3024!$acc loop seq
3025# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3026#elif defined(MFC_OpenMP)
3027# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3028
3029# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3030#endif
3031 do q = 0, weno_num_stencils
3032 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3033 end do
3034
3035 elseif (teno) then
3036 ! Fu, et al. (2016)
3037 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3038 tau = abs(beta(2) - beta(0))
3039
3040# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3041#if defined(MFC_OpenACC)
3042# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3043!$acc loop seq
3044# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3045#elif defined(MFC_OpenMP)
3046# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3047
3048# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3049#endif
3050 do q = 0, weno_num_stencils
3051 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3052 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3053 end do
3054 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3055
3056
3057# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3058#if defined(MFC_OpenACC)
3059# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3060!$acc loop seq
3061# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3062#elif defined(MFC_OpenMP)
3063# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3064
3065# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3066#endif
3067 do q = 0, weno_num_stencils
3068 if (omega(q) < teno_ct) then ! Equation 26
3069 delta(q) = 0._wp
3070 else
3071 delta(q) = 1._wp
3072 end if
3073 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3074 end do
3075 end if
3076
3077 omega = alpha/sum(alpha)
3078
3079 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3080
3081 ! reconstruct from right side
3082
3083 poly(0) = v_rs_ws_x(j, k, l, i) &
3084 + poly_coef_cbr_x(j, 0, 0)*dvd(1) &
3085 + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3086 poly(1) = v_rs_ws_x(j, k, l, i) &
3087 + poly_coef_cbr_x(j, 1, 0)*dvd(0) &
3088 + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3089 poly(2) = v_rs_ws_x(j, k, l, i) &
3090 + poly_coef_cbr_x(j, 2, 0)*dvd(-1) &
3091 + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3092
3093 if (wenojs) then
3094 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3095
3096 elseif (mapped_weno) then
3097 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3098 omega = alpha/sum(alpha)
3099 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, j)*(1._wp + d_cbr_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3100 *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_x(0:weno_num_stencils, j))))
3101
3102 elseif (wenoz) then
3103
3104
3105# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3106#if defined(MFC_OpenACC)
3107# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3108!$acc loop seq
3109# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3110#elif defined(MFC_OpenMP)
3111# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3112
3113# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3114#endif
3115 do q = 0, weno_num_stencils
3116 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3117 end do
3118
3119 elseif (teno) then
3120
3121# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3122#if defined(MFC_OpenACC)
3123# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3124!$acc loop seq
3125# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3126#elif defined(MFC_OpenMP)
3127# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3128
3129# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3130#endif
3131 do q = 0, weno_num_stencils
3132 alpha(q) = delta(q)*d_cbr_x(q, j)
3133 end do
3134 end if
3135
3136 omega = alpha/sum(alpha)
3137
3138 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3139
3140 end do
3141 end do
3142 end do
3143 end do
3144
3145# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3146
3147# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3148#if defined(MFC_OpenACC)
3149# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3150!$acc end parallel loop
3151# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3152#elif defined(MFC_OpenMP)
3153# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3154
3155# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3156
3157# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3158!$omp end target teams loop
3159# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3160#endif
3161# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3162
3163
3164 if (mp_weno) then
3165 call s_preserve_monotonicity(v_rs_ws_x, vl_rs_vf_x, &
3166 vr_rs_vf_x)
3167 end if
3168 end if
3169# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3170 if (weno_dir == 2) then
3171
3172# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3173
3174# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175#if defined(MFC_OpenACC)
3176# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3178# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179#elif defined(MFC_OpenMP)
3180# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3181
3182# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3183
3184# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3185
3186# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3187!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3188# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3189#endif
3190# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3191
3192 do l = is3_weno%beg, is3_weno%end
3193 do k = is2_weno%beg, is2_weno%end
3194 do j = is1_weno%beg, is1_weno%end
3195
3196# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3197#if defined(MFC_OpenACC)
3198# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199!$acc loop seq
3200# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201#elif defined(MFC_OpenMP)
3202# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203
3204# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205#endif
3206 do i = 1, v_size
3207 ! reconstruct from left side
3208
3209 alpha(:) = 0._wp
3210 omega(:) = 0._wp
3211 delta(:) = 0._wp
3212 beta(:) = weno_eps
3213
3214 dvd(1) = v_rs_ws_y(j + 2, k, l, i) &
3215 - v_rs_ws_y(j + 1, k, l, i)
3216 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
3217 - v_rs_ws_y(j, k, l, i)
3218 dvd(-1) = v_rs_ws_y(j, k, l, i) &
3219 - v_rs_ws_y(j - 1, k, l, i)
3220 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) &
3221 - v_rs_ws_y(j - 2, k, l, i)
3222
3223 poly(0) = v_rs_ws_y(j, k, l, i) &
3224 + poly_coef_cbl_y(j, 0, 0)*dvd(1) &
3225 + poly_coef_cbl_y(j, 0, 1)*dvd(0)
3226 poly(1) = v_rs_ws_y(j, k, l, i) &
3227 + poly_coef_cbl_y(j, 1, 0)*dvd(0) &
3228 + poly_coef_cbl_y(j, 1, 1)*dvd(-1)
3229 poly(2) = v_rs_ws_y(j, k, l, i) &
3230 + poly_coef_cbl_y(j, 2, 0)*dvd(-1) &
3231 + poly_coef_cbl_y(j, 2, 1)*dvd(-2)
3232
3233 beta(0) = beta_coef_y(j, 0, 0)*dvd(1)*dvd(1) &
3234 + beta_coef_y(j, 0, 1)*dvd(1)*dvd(0) &
3235 + beta_coef_y(j, 0, 2)*dvd(0)*dvd(0) &
3236 + weno_eps
3237 beta(1) = beta_coef_y(j, 1, 0)*dvd(0)*dvd(0) &
3238 + beta_coef_y(j, 1, 1)*dvd(0)*dvd(-1) &
3239 + beta_coef_y(j, 1, 2)*dvd(-1)*dvd(-1) &
3240 + weno_eps
3241 beta(2) = beta_coef_y(j, 2, 0)*dvd(-1)*dvd(-1) &
3242 + beta_coef_y(j, 2, 1)*dvd(-1)*dvd(-2) &
3243 + beta_coef_y(j, 2, 2)*dvd(-2)*dvd(-2) &
3244 + weno_eps
3245
3246 if (wenojs) then
3247 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3248
3249 elseif (mapped_weno) then
3250 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3251 omega = alpha/sum(alpha)
3252 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, j)*(1._wp + d_cbl_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3253 *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_y(0:weno_num_stencils, j))))
3254
3255 elseif (wenoz) then
3256
3257 ! Borges, et al. (2008)
3258
3259 tau = abs(beta(2) - beta(0)) ! Equation 25
3260
3261# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3262#if defined(MFC_OpenACC)
3263# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3264!$acc loop seq
3265# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3266#elif defined(MFC_OpenMP)
3267# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3268
3269# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3270#endif
3271 do q = 0, weno_num_stencils
3272 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3273 end do
3274
3275 elseif (teno) then
3276 ! Fu, et al. (2016)
3277 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3278 tau = abs(beta(2) - beta(0))
3279
3280# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3281#if defined(MFC_OpenACC)
3282# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3283!$acc loop seq
3284# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285#elif defined(MFC_OpenMP)
3286# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3287
3288# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3289#endif
3290 do q = 0, weno_num_stencils
3291 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3292 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3293 end do
3294 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3295
3296
3297# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3298#if defined(MFC_OpenACC)
3299# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3300!$acc loop seq
3301# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3302#elif defined(MFC_OpenMP)
3303# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3304
3305# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3306#endif
3307 do q = 0, weno_num_stencils
3308 if (omega(q) < teno_ct) then ! Equation 26
3309 delta(q) = 0._wp
3310 else
3311 delta(q) = 1._wp
3312 end if
3313 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
3314 end do
3315 end if
3316
3317 omega = alpha/sum(alpha)
3318
3319 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3320
3321 ! reconstruct from right side
3322
3323 poly(0) = v_rs_ws_y(j, k, l, i) &
3324 + poly_coef_cbr_y(j, 0, 0)*dvd(1) &
3325 + poly_coef_cbr_y(j, 0, 1)*dvd(0)
3326 poly(1) = v_rs_ws_y(j, k, l, i) &
3327 + poly_coef_cbr_y(j, 1, 0)*dvd(0) &
3328 + poly_coef_cbr_y(j, 1, 1)*dvd(-1)
3329 poly(2) = v_rs_ws_y(j, k, l, i) &
3330 + poly_coef_cbr_y(j, 2, 0)*dvd(-1) &
3331 + poly_coef_cbr_y(j, 2, 1)*dvd(-2)
3332
3333 if (wenojs) then
3334 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3335
3336 elseif (mapped_weno) then
3337 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3338 omega = alpha/sum(alpha)
3339 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, j)*(1._wp + d_cbr_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3340 *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_y(0:weno_num_stencils, j))))
3341
3342 elseif (wenoz) then
3343
3344
3345# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3346#if defined(MFC_OpenACC)
3347# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3348!$acc loop seq
3349# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3350#elif defined(MFC_OpenMP)
3351# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3352
3353# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3354#endif
3355 do q = 0, weno_num_stencils
3356 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q)))
3357 end do
3358
3359 elseif (teno) then
3360
3361# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3362#if defined(MFC_OpenACC)
3363# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3364!$acc loop seq
3365# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3366#elif defined(MFC_OpenMP)
3367# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3368
3369# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3370#endif
3371 do q = 0, weno_num_stencils
3372 alpha(q) = delta(q)*d_cbr_y(q, j)
3373 end do
3374 end if
3375
3376 omega = alpha/sum(alpha)
3377
3378 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3379
3380 end do
3381 end do
3382 end do
3383 end do
3384
3385# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3386
3387# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3388#if defined(MFC_OpenACC)
3389# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3390!$acc end parallel loop
3391# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3392#elif defined(MFC_OpenMP)
3393# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3394
3395# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3396
3397# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3398!$omp end target teams loop
3399# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3400#endif
3401# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3402
3403
3404 if (mp_weno) then
3405 call s_preserve_monotonicity(v_rs_ws_y, vl_rs_vf_y, &
3406 vr_rs_vf_y)
3407 end if
3408 end if
3409# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3410 if (weno_dir == 3) then
3411
3412# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3413
3414# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3415#if defined(MFC_OpenACC)
3416# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3417!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3418# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3419#elif defined(MFC_OpenMP)
3420# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3421
3422# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3423
3424# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3425
3426# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3427!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3428# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429#endif
3430# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3431
3432 do l = is3_weno%beg, is3_weno%end
3433 do k = is2_weno%beg, is2_weno%end
3434 do j = is1_weno%beg, is1_weno%end
3435
3436# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3437#if defined(MFC_OpenACC)
3438# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3439!$acc loop seq
3440# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3441#elif defined(MFC_OpenMP)
3442# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3443
3444# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3445#endif
3446 do i = 1, v_size
3447 ! reconstruct from left side
3448
3449 alpha(:) = 0._wp
3450 omega(:) = 0._wp
3451 delta(:) = 0._wp
3452 beta(:) = weno_eps
3453
3454 dvd(1) = v_rs_ws_z(j + 2, k, l, i) &
3455 - v_rs_ws_z(j + 1, k, l, i)
3456 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
3457 - v_rs_ws_z(j, k, l, i)
3458 dvd(-1) = v_rs_ws_z(j, k, l, i) &
3459 - v_rs_ws_z(j - 1, k, l, i)
3460 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) &
3461 - v_rs_ws_z(j - 2, k, l, i)
3462
3463 poly(0) = v_rs_ws_z(j, k, l, i) &
3464 + poly_coef_cbl_z(j, 0, 0)*dvd(1) &
3465 + poly_coef_cbl_z(j, 0, 1)*dvd(0)
3466 poly(1) = v_rs_ws_z(j, k, l, i) &
3467 + poly_coef_cbl_z(j, 1, 0)*dvd(0) &
3468 + poly_coef_cbl_z(j, 1, 1)*dvd(-1)
3469 poly(2) = v_rs_ws_z(j, k, l, i) &
3470 + poly_coef_cbl_z(j, 2, 0)*dvd(-1) &
3471 + poly_coef_cbl_z(j, 2, 1)*dvd(-2)
3472
3473 beta(0) = beta_coef_z(j, 0, 0)*dvd(1)*dvd(1) &
3474 + beta_coef_z(j, 0, 1)*dvd(1)*dvd(0) &
3475 + beta_coef_z(j, 0, 2)*dvd(0)*dvd(0) &
3476 + weno_eps
3477 beta(1) = beta_coef_z(j, 1, 0)*dvd(0)*dvd(0) &
3478 + beta_coef_z(j, 1, 1)*dvd(0)*dvd(-1) &
3479 + beta_coef_z(j, 1, 2)*dvd(-1)*dvd(-1) &
3480 + weno_eps
3481 beta(2) = beta_coef_z(j, 2, 0)*dvd(-1)*dvd(-1) &
3482 + beta_coef_z(j, 2, 1)*dvd(-1)*dvd(-2) &
3483 + beta_coef_z(j, 2, 2)*dvd(-2)*dvd(-2) &
3484 + weno_eps
3485
3486 if (wenojs) then
3487 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3488
3489 elseif (mapped_weno) then
3490 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3491 omega = alpha/sum(alpha)
3492 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, j)*(1._wp + d_cbl_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3493 *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_z(0:weno_num_stencils, j))))
3494
3495 elseif (wenoz) then
3496
3497 ! Borges, et al. (2008)
3498
3499 tau = abs(beta(2) - beta(0)) ! Equation 25
3500
3501# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3502#if defined(MFC_OpenACC)
3503# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3504!$acc loop seq
3505# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3506#elif defined(MFC_OpenMP)
3507# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3508
3509# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3510#endif
3511 do q = 0, weno_num_stencils
3512 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3513 end do
3514
3515 elseif (teno) then
3516 ! Fu, et al. (2016)
3517 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3518 tau = abs(beta(2) - beta(0))
3519
3520# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3521#if defined(MFC_OpenACC)
3522# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3523!$acc loop seq
3524# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3525#elif defined(MFC_OpenMP)
3526# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3527
3528# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3529#endif
3530 do q = 0, weno_num_stencils
3531 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3532 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3533 end do
3534 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3535
3536
3537# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3538#if defined(MFC_OpenACC)
3539# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540!$acc loop seq
3541# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3542#elif defined(MFC_OpenMP)
3543# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3544
3545# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546#endif
3547 do q = 0, weno_num_stencils
3548 if (omega(q) < teno_ct) then ! Equation 26
3549 delta(q) = 0._wp
3550 else
3551 delta(q) = 1._wp
3552 end if
3553 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
3554 end do
3555 end if
3556
3557 omega = alpha/sum(alpha)
3558
3559 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3560
3561 ! reconstruct from right side
3562
3563 poly(0) = v_rs_ws_z(j, k, l, i) &
3564 + poly_coef_cbr_z(j, 0, 0)*dvd(1) &
3565 + poly_coef_cbr_z(j, 0, 1)*dvd(0)
3566 poly(1) = v_rs_ws_z(j, k, l, i) &
3567 + poly_coef_cbr_z(j, 1, 0)*dvd(0) &
3568 + poly_coef_cbr_z(j, 1, 1)*dvd(-1)
3569 poly(2) = v_rs_ws_z(j, k, l, i) &
3570 + poly_coef_cbr_z(j, 2, 0)*dvd(-1) &
3571 + poly_coef_cbr_z(j, 2, 1)*dvd(-2)
3572
3573 if (wenojs) then
3574 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3575
3576 elseif (mapped_weno) then
3577 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3578 omega = alpha/sum(alpha)
3579 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, j)*(1._wp + d_cbr_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3580 *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_z(0:weno_num_stencils, j))))
3581
3582 elseif (wenoz) then
3583
3584
3585# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3586#if defined(MFC_OpenACC)
3587# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3588!$acc loop seq
3589# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3590#elif defined(MFC_OpenMP)
3591# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3592
3593# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3594#endif
3595 do q = 0, weno_num_stencils
3596 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q)))
3597 end do
3598
3599 elseif (teno) then
3600
3601# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3602#if defined(MFC_OpenACC)
3603# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3604!$acc loop seq
3605# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3606#elif defined(MFC_OpenMP)
3607# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3608
3609# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3610#endif
3611 do q = 0, weno_num_stencils
3612 alpha(q) = delta(q)*d_cbr_z(q, j)
3613 end do
3614 end if
3615
3616 omega = alpha/sum(alpha)
3617
3618 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3619
3620 end do
3621 end do
3622 end do
3623 end do
3624
3625# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3626
3627# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3628#if defined(MFC_OpenACC)
3629# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3630!$acc end parallel loop
3631# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3632#elif defined(MFC_OpenMP)
3633# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3634
3635# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3636
3637# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3638!$omp end target teams loop
3639# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3640#endif
3641# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3642
3643
3644 if (mp_weno) then
3645 call s_preserve_monotonicity(v_rs_ws_z, vl_rs_vf_z, &
3646 vr_rs_vf_z)
3647 end if
3648 end if
3649# 941 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3650# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3651 end if
3652 if (weno_order == 7 .or. dummy) then
3653# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3654# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3655 if (weno_dir == 1) then
3656
3657# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3658
3659# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3660#if defined(MFC_OpenACC)
3661# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3662!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3663# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3664#elif defined(MFC_OpenMP)
3665# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3666
3667# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3668
3669# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3670
3671# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3672!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3673# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3674#endif
3675# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676
3677 do l = is3_weno%beg, is3_weno%end
3678 do k = is2_weno%beg, is2_weno%end
3679 do j = is1_weno%beg, is1_weno%end
3680
3681# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3682#if defined(MFC_OpenACC)
3683# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3684!$acc loop seq
3685# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3686#elif defined(MFC_OpenMP)
3687# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3688
3689# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3690#endif
3691 do i = 1, v_size
3692
3693 alpha(:) = 0._wp
3694 omega(:) = 0._wp
3695 delta(:) = 0._wp
3696 beta(:) = weno_eps
3697
3698 if (teno) v = v_rs_ws_x(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
3699
3700 if (.not. teno) then
3701 dvd(2) = v_rs_ws_x(j + 3, k, l, i) &
3702 - v_rs_ws_x(j + 2, k, l, i)
3703 dvd(1) = v_rs_ws_x(j + 2, k, l, i) &
3704 - v_rs_ws_x(j + 1, k, l, i)
3705 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
3706 - v_rs_ws_x(j, k, l, i)
3707 dvd(-1) = v_rs_ws_x(j, k, l, i) &
3708 - v_rs_ws_x(j - 1, k, l, i)
3709 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) &
3710 - v_rs_ws_x(j - 2, k, l, i)
3711 dvd(-3) = v_rs_ws_x(j - 2, k, l, i) &
3712 - v_rs_ws_x(j - 3, k, l, i)
3713
3714 poly(3) = v_rs_ws_x(j, k, l, i) &
3715 + poly_coef_cbl_x(j, 0, 0)*dvd(2) &
3716 + poly_coef_cbl_x(j, 0, 1)*dvd(1) &
3717 + poly_coef_cbl_x(j, 0, 2)*dvd(0)
3718 poly(2) = v_rs_ws_x(j, k, l, i) &
3719 + poly_coef_cbl_x(j, 1, 0)*dvd(1) &
3720 + poly_coef_cbl_x(j, 1, 1)*dvd(0) &
3721 + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
3722 poly(1) = v_rs_ws_x(j, k, l, i) &
3723 + poly_coef_cbl_x(j, 2, 0)*dvd(0) &
3724 + poly_coef_cbl_x(j, 2, 1)*dvd(-1) &
3725 + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
3726 poly(0) = v_rs_ws_x(j, k, l, i) &
3727 + poly_coef_cbl_x(j, 3, 0)*dvd(-1) &
3728 + poly_coef_cbl_x(j, 3, 1)*dvd(-2) &
3729 + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
3730
3731 else
3732# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3733 ! (Fu, et al., 2016) Table 1
3734 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
3735 ! See Figure 2 (right) for right-sided flux (at i+1/2)
3736 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
3737 ! But we need to keep the stencil order to reuse the beta coefficients
3738 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
3739 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
3740 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
3741 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
3742 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
3743# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3744 end if
3745
3746 if (.not. teno) then
3747
3748 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) &
3749 + beta_coef_x(j, 0, 1)*dvd(2)*dvd(1) &
3750 + beta_coef_x(j, 0, 2)*dvd(2)*dvd(0) &
3751 + beta_coef_x(j, 0, 3)*dvd(1)*dvd(1) &
3752 + beta_coef_x(j, 0, 4)*dvd(1)*dvd(0) &
3753 + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) &
3754 + weno_eps
3755
3756 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) &
3757 + beta_coef_x(j, 1, 1)*dvd(1)*dvd(0) &
3758 + beta_coef_x(j, 1, 2)*dvd(1)*dvd(-1) &
3759 + beta_coef_x(j, 1, 3)*dvd(0)*dvd(0) &
3760 + beta_coef_x(j, 1, 4)*dvd(0)*dvd(-1) &
3761 + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) &
3762 + weno_eps
3763
3764 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) &
3765 + beta_coef_x(j, 2, 1)*dvd(0)*dvd(-1) &
3766 + beta_coef_x(j, 2, 2)*dvd(0)*dvd(-2) &
3767 + beta_coef_x(j, 2, 3)*dvd(-1)*dvd(-1) &
3768 + beta_coef_x(j, 2, 4)*dvd(-1)*dvd(-2) &
3769 + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) &
3770 + weno_eps
3771
3772 beta(0) = beta_coef_x(j, 3, 0)*dvd(-1)*dvd(-1) &
3773 + beta_coef_x(j, 3, 1)*dvd(-1)*dvd(-2) &
3774 + beta_coef_x(j, 3, 2)*dvd(-1)*dvd(-3) &
3775 + beta_coef_x(j, 3, 3)*dvd(-2)*dvd(-2) &
3776 + beta_coef_x(j, 3, 4)*dvd(-2)*dvd(-3) &
3777 + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) &
3778 + weno_eps
3779
3780 else ! TENO
3781# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3782 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
3783 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v( 0) + v( 1))**2._wp + (( v(-1) - v( 1))**2._wp)/4._wp + weno_eps !&
3784 beta(1) = 13._wp/12._wp*(v( 0) - 2._wp*v( 1) + v( 2))**2._wp + ((3._wp*v( 0) - 4._wp*v( 1) + v( 2))**2._wp)/4._wp + weno_eps !&
3785 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v( 0))**2._wp + (( v(-2) - 4._wp*v(-1) + 3._wp*v( 0))**2._wp)/4._wp + weno_eps !&
3786
3787 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
3788 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
3789 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
3790 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
3791 + weno_eps !&
3792
3793 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
3794 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
3795 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
3796 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
3797 + weno_eps !&
3798# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3799 end if
3800
3801 if (wenojs) then
3802 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3803
3804 elseif (mapped_weno) then
3805 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3806 omega = alpha/sum(alpha)
3807 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, j)*(1._wp + d_cbl_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3808 *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_x(0:weno_num_stencils, j))))
3809
3810 elseif (wenoz) then
3811 ! Castro, et al. (2010)
3812 ! Don & Borges (2013) also helps
3813 tau = abs(beta(3) - beta(0)) ! Equation 50
3814
3815# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3816#if defined(MFC_OpenACC)
3817# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3818!$acc loop seq
3819# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3820#elif defined(MFC_OpenMP)
3821# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3822
3823# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3824#endif
3825 do q = 0, weno_num_stencils
3826 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
3827 end do
3828
3829 elseif (teno) then
3830# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3831 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
3832 alpha = 1._wp + tau/beta
3833 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
3834 omega = alpha/sum(alpha)
3835
3836
3837# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3838#if defined(MFC_OpenACC)
3839# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3840!$acc loop seq
3841# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3842#elif defined(MFC_OpenMP)
3843# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3844
3845# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3846#endif
3847 do q = 0, weno_num_stencils
3848 if (omega(q) < teno_ct) then ! Equation 26
3849 delta(q) = 0._wp
3850 else
3851 delta(q) = 1._wp
3852 end if
3853 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3854 end do
3855# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3856 end if
3857
3858 omega = alpha/sum(alpha)
3859
3860 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
3861
3862 if (teno) then
3863# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3864 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
3865# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3866 end if
3867
3868 if (.not. teno) then
3869 poly(3) = v_rs_ws_x(j, k, l, i) &
3870 + poly_coef_cbr_x(j, 0, 0)*dvd(2) &
3871 + poly_coef_cbr_x(j, 0, 1)*dvd(1) &
3872 + poly_coef_cbr_x(j, 0, 2)*dvd(0)
3873 poly(2) = v_rs_ws_x(j, k, l, i) &
3874 + poly_coef_cbr_x(j, 1, 0)*dvd(1) &
3875 + poly_coef_cbr_x(j, 1, 1)*dvd(0) &
3876 + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
3877 poly(1) = v_rs_ws_x(j, k, l, i) &
3878 + poly_coef_cbr_x(j, 2, 0)*dvd(0) &
3879 + poly_coef_cbr_x(j, 2, 1)*dvd(-1) &
3880 + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
3881 poly(0) = v_rs_ws_x(j, k, l, i) &
3882 + poly_coef_cbr_x(j, 3, 0)*dvd(-1) &
3883 + poly_coef_cbr_x(j, 3, 1)*dvd(-2) &
3884 + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
3885 else
3886# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3887 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
3888 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
3889 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
3890 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
3891 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
3892# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3893 end if
3894
3895 if (wenojs) then
3896 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3897
3898 elseif (mapped_weno) then
3899 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3900 omega = alpha/sum(alpha)
3901 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, j)*(1._wp + d_cbr_x(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3902 *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_x(0:weno_num_stencils, j))))
3903
3904 elseif (wenoz) then
3905
3906
3907# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3908#if defined(MFC_OpenACC)
3909# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3910!$acc loop seq
3911# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3912#elif defined(MFC_OpenMP)
3913# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3914
3915# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916#endif
3917 do q = 0, weno_num_stencils
3918 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
3919 end do
3920
3921 elseif (teno) then
3922
3923# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3924#if defined(MFC_OpenACC)
3925# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3926!$acc loop seq
3927# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3928#elif defined(MFC_OpenMP)
3929# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3930
3931# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3932#endif
3933 do q = 0, weno_num_stencils
3934 alpha(q) = delta(q)*d_cbr_x(q, j)
3935 end do
3936 end if
3937
3938 omega = alpha/sum(alpha)
3939
3940 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
3941
3942 if (teno) then
3943# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3944 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
3945# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3946 end if
3947
3948 end do
3949 end do
3950 end do
3951 end do
3952
3953# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3954
3955# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3956#if defined(MFC_OpenACC)
3957# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3958!$acc end parallel loop
3959# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3960#elif defined(MFC_OpenMP)
3961# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3962
3963# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3964
3965# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3966!$omp end target teams loop
3967# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3968#endif
3969# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3970
3971 end if
3972# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973 if (weno_dir == 2) then
3974
3975# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3976
3977# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3978#if defined(MFC_OpenACC)
3979# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3980!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3981# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3982#elif defined(MFC_OpenMP)
3983# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3984
3985# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3986
3987# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3988
3989# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3990!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3991# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3992#endif
3993# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3994
3995 do l = is3_weno%beg, is3_weno%end
3996 do k = is2_weno%beg, is2_weno%end
3997 do j = is1_weno%beg, is1_weno%end
3998
3999# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4000#if defined(MFC_OpenACC)
4001# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4002!$acc loop seq
4003# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4004#elif defined(MFC_OpenMP)
4005# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4006
4007# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4008#endif
4009 do i = 1, v_size
4010
4011 alpha(:) = 0._wp
4012 omega(:) = 0._wp
4013 delta(:) = 0._wp
4014 beta(:) = weno_eps
4015
4016 if (teno) v = v_rs_ws_y(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
4017
4018 if (.not. teno) then
4019 dvd(2) = v_rs_ws_y(j + 3, k, l, i) &
4020 - v_rs_ws_y(j + 2, k, l, i)
4021 dvd(1) = v_rs_ws_y(j + 2, k, l, i) &
4022 - v_rs_ws_y(j + 1, k, l, i)
4023 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
4024 - v_rs_ws_y(j, k, l, i)
4025 dvd(-1) = v_rs_ws_y(j, k, l, i) &
4026 - v_rs_ws_y(j - 1, k, l, i)
4027 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) &
4028 - v_rs_ws_y(j - 2, k, l, i)
4029 dvd(-3) = v_rs_ws_y(j - 2, k, l, i) &
4030 - v_rs_ws_y(j - 3, k, l, i)
4031
4032 poly(3) = v_rs_ws_y(j, k, l, i) &
4033 + poly_coef_cbl_y(j, 0, 0)*dvd(2) &
4034 + poly_coef_cbl_y(j, 0, 1)*dvd(1) &
4035 + poly_coef_cbl_y(j, 0, 2)*dvd(0)
4036 poly(2) = v_rs_ws_y(j, k, l, i) &
4037 + poly_coef_cbl_y(j, 1, 0)*dvd(1) &
4038 + poly_coef_cbl_y(j, 1, 1)*dvd(0) &
4039 + poly_coef_cbl_y(j, 1, 2)*dvd(-1)
4040 poly(1) = v_rs_ws_y(j, k, l, i) &
4041 + poly_coef_cbl_y(j, 2, 0)*dvd(0) &
4042 + poly_coef_cbl_y(j, 2, 1)*dvd(-1) &
4043 + poly_coef_cbl_y(j, 2, 2)*dvd(-2)
4044 poly(0) = v_rs_ws_y(j, k, l, i) &
4045 + poly_coef_cbl_y(j, 3, 0)*dvd(-1) &
4046 + poly_coef_cbl_y(j, 3, 1)*dvd(-2) &
4047 + poly_coef_cbl_y(j, 3, 2)*dvd(-3)
4048
4049 else
4050# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4051 ! (Fu, et al., 2016) Table 1
4052 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
4053 ! See Figure 2 (right) for right-sided flux (at i+1/2)
4054 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
4055 ! But we need to keep the stencil order to reuse the beta coefficients
4056 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
4057 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
4058 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
4059 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
4060 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
4061# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4062 end if
4063
4064 if (.not. teno) then
4065
4066 beta(3) = beta_coef_y(j, 0, 0)*dvd(2)*dvd(2) &
4067 + beta_coef_y(j, 0, 1)*dvd(2)*dvd(1) &
4068 + beta_coef_y(j, 0, 2)*dvd(2)*dvd(0) &
4069 + beta_coef_y(j, 0, 3)*dvd(1)*dvd(1) &
4070 + beta_coef_y(j, 0, 4)*dvd(1)*dvd(0) &
4071 + beta_coef_y(j, 0, 5)*dvd(0)*dvd(0) &
4072 + weno_eps
4073
4074 beta(2) = beta_coef_y(j, 1, 0)*dvd(1)*dvd(1) &
4075 + beta_coef_y(j, 1, 1)*dvd(1)*dvd(0) &
4076 + beta_coef_y(j, 1, 2)*dvd(1)*dvd(-1) &
4077 + beta_coef_y(j, 1, 3)*dvd(0)*dvd(0) &
4078 + beta_coef_y(j, 1, 4)*dvd(0)*dvd(-1) &
4079 + beta_coef_y(j, 1, 5)*dvd(-1)*dvd(-1) &
4080 + weno_eps
4081
4082 beta(1) = beta_coef_y(j, 2, 0)*dvd(0)*dvd(0) &
4083 + beta_coef_y(j, 2, 1)*dvd(0)*dvd(-1) &
4084 + beta_coef_y(j, 2, 2)*dvd(0)*dvd(-2) &
4085 + beta_coef_y(j, 2, 3)*dvd(-1)*dvd(-1) &
4086 + beta_coef_y(j, 2, 4)*dvd(-1)*dvd(-2) &
4087 + beta_coef_y(j, 2, 5)*dvd(-2)*dvd(-2) &
4088 + weno_eps
4089
4090 beta(0) = beta_coef_y(j, 3, 0)*dvd(-1)*dvd(-1) &
4091 + beta_coef_y(j, 3, 1)*dvd(-1)*dvd(-2) &
4092 + beta_coef_y(j, 3, 2)*dvd(-1)*dvd(-3) &
4093 + beta_coef_y(j, 3, 3)*dvd(-2)*dvd(-2) &
4094 + beta_coef_y(j, 3, 4)*dvd(-2)*dvd(-3) &
4095 + beta_coef_y(j, 3, 5)*dvd(-3)*dvd(-3) &
4096 + weno_eps
4097
4098 else ! TENO
4099# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4100 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
4101 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v( 0) + v( 1))**2._wp + (( v(-1) - v( 1))**2._wp)/4._wp + weno_eps !&
4102 beta(1) = 13._wp/12._wp*(v( 0) - 2._wp*v( 1) + v( 2))**2._wp + ((3._wp*v( 0) - 4._wp*v( 1) + v( 2))**2._wp)/4._wp + weno_eps !&
4103 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v( 0))**2._wp + (( v(-2) - 4._wp*v(-1) + 3._wp*v( 0))**2._wp)/4._wp + weno_eps !&
4104
4105 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
4106 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
4107 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
4108 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
4109 + weno_eps !&
4110
4111 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
4112 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
4113 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
4114 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
4115 + weno_eps !&
4116# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4117 end if
4118
4119 if (wenojs) then
4120 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4121
4122 elseif (mapped_weno) then
4123 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4124 omega = alpha/sum(alpha)
4125 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, j)*(1._wp + d_cbl_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4126 *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_y(0:weno_num_stencils, j))))
4127
4128 elseif (wenoz) then
4129 ! Castro, et al. (2010)
4130 ! Don & Borges (2013) also helps
4131 tau = abs(beta(3) - beta(0)) ! Equation 50
4132
4133# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4134#if defined(MFC_OpenACC)
4135# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4136!$acc loop seq
4137# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4138#elif defined(MFC_OpenMP)
4139# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4140
4141# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4142#endif
4143 do q = 0, weno_num_stencils
4144 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4145 end do
4146
4147 elseif (teno) then
4148# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4149 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4150 alpha = 1._wp + tau/beta
4151 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4152 omega = alpha/sum(alpha)
4153
4154
4155# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4156#if defined(MFC_OpenACC)
4157# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4158!$acc loop seq
4159# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4160#elif defined(MFC_OpenMP)
4161# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4162
4163# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4164#endif
4165 do q = 0, weno_num_stencils
4166 if (omega(q) < teno_ct) then ! Equation 26
4167 delta(q) = 0._wp
4168 else
4169 delta(q) = 1._wp
4170 end if
4171 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4172 end do
4173# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4174 end if
4175
4176 omega = alpha/sum(alpha)
4177
4178 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4179
4180 if (teno) then
4181# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4182 vl_rs_vf_y(j, k, l, i) = vl_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4183# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4184 end if
4185
4186 if (.not. teno) then
4187 poly(3) = v_rs_ws_y(j, k, l, i) &
4188 + poly_coef_cbr_y(j, 0, 0)*dvd(2) &
4189 + poly_coef_cbr_y(j, 0, 1)*dvd(1) &
4190 + poly_coef_cbr_y(j, 0, 2)*dvd(0)
4191 poly(2) = v_rs_ws_y(j, k, l, i) &
4192 + poly_coef_cbr_y(j, 1, 0)*dvd(1) &
4193 + poly_coef_cbr_y(j, 1, 1)*dvd(0) &
4194 + poly_coef_cbr_y(j, 1, 2)*dvd(-1)
4195 poly(1) = v_rs_ws_y(j, k, l, i) &
4196 + poly_coef_cbr_y(j, 2, 0)*dvd(0) &
4197 + poly_coef_cbr_y(j, 2, 1)*dvd(-1) &
4198 + poly_coef_cbr_y(j, 2, 2)*dvd(-2)
4199 poly(0) = v_rs_ws_y(j, k, l, i) &
4200 + poly_coef_cbr_y(j, 3, 0)*dvd(-1) &
4201 + poly_coef_cbr_y(j, 3, 1)*dvd(-2) &
4202 + poly_coef_cbr_y(j, 3, 2)*dvd(-3)
4203 else
4204# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4205 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
4206 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
4207 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
4208 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
4209 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
4210# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4211 end if
4212
4213 if (wenojs) then
4214 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4215
4216 elseif (mapped_weno) then
4217 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4218 omega = alpha/sum(alpha)
4219 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, j)*(1._wp + d_cbr_y(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4220 *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_y(0:weno_num_stencils, j))))
4221
4222 elseif (wenoz) then
4223
4224
4225# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4226#if defined(MFC_OpenACC)
4227# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4228!$acc loop seq
4229# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4230#elif defined(MFC_OpenMP)
4231# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4232
4233# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4234#endif
4235 do q = 0, weno_num_stencils
4236 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4237 end do
4238
4239 elseif (teno) then
4240
4241# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4242#if defined(MFC_OpenACC)
4243# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4244!$acc loop seq
4245# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4246#elif defined(MFC_OpenMP)
4247# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4248
4249# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4250#endif
4251 do q = 0, weno_num_stencils
4252 alpha(q) = delta(q)*d_cbr_y(q, j)
4253 end do
4254 end if
4255
4256 omega = alpha/sum(alpha)
4257
4258 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4259
4260 if (teno) then
4261# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4262 vr_rs_vf_y(j, k, l, i) = vr_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4263# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4264 end if
4265
4266 end do
4267 end do
4268 end do
4269 end do
4270
4271# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4272
4273# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4274#if defined(MFC_OpenACC)
4275# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4276!$acc end parallel loop
4277# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4278#elif defined(MFC_OpenMP)
4279# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4280
4281# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4282
4283# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4284!$omp end target teams loop
4285# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4286#endif
4287# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4288
4289 end if
4290# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4291 if (weno_dir == 3) then
4292
4293# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4294
4295# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4296#if defined(MFC_OpenACC)
4297# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4298!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4299# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4300#elif defined(MFC_OpenMP)
4301# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4302
4303# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4304
4305# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4306
4307# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4308!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4309# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4310#endif
4311# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4312
4313 do l = is3_weno%beg, is3_weno%end
4314 do k = is2_weno%beg, is2_weno%end
4315 do j = is1_weno%beg, is1_weno%end
4316
4317# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4318#if defined(MFC_OpenACC)
4319# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4320!$acc loop seq
4321# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4322#elif defined(MFC_OpenMP)
4323# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4324
4325# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4326#endif
4327 do i = 1, v_size
4328
4329 alpha(:) = 0._wp
4330 omega(:) = 0._wp
4331 delta(:) = 0._wp
4332 beta(:) = weno_eps
4333
4334 if (teno) v = v_rs_ws_z(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
4335
4336 if (.not. teno) then
4337 dvd(2) = v_rs_ws_z(j + 3, k, l, i) &
4338 - v_rs_ws_z(j + 2, k, l, i)
4339 dvd(1) = v_rs_ws_z(j + 2, k, l, i) &
4340 - v_rs_ws_z(j + 1, k, l, i)
4341 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
4342 - v_rs_ws_z(j, k, l, i)
4343 dvd(-1) = v_rs_ws_z(j, k, l, i) &
4344 - v_rs_ws_z(j - 1, k, l, i)
4345 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) &
4346 - v_rs_ws_z(j - 2, k, l, i)
4347 dvd(-3) = v_rs_ws_z(j - 2, k, l, i) &
4348 - v_rs_ws_z(j - 3, k, l, i)
4349
4350 poly(3) = v_rs_ws_z(j, k, l, i) &
4351 + poly_coef_cbl_z(j, 0, 0)*dvd(2) &
4352 + poly_coef_cbl_z(j, 0, 1)*dvd(1) &
4353 + poly_coef_cbl_z(j, 0, 2)*dvd(0)
4354 poly(2) = v_rs_ws_z(j, k, l, i) &
4355 + poly_coef_cbl_z(j, 1, 0)*dvd(1) &
4356 + poly_coef_cbl_z(j, 1, 1)*dvd(0) &
4357 + poly_coef_cbl_z(j, 1, 2)*dvd(-1)
4358 poly(1) = v_rs_ws_z(j, k, l, i) &
4359 + poly_coef_cbl_z(j, 2, 0)*dvd(0) &
4360 + poly_coef_cbl_z(j, 2, 1)*dvd(-1) &
4361 + poly_coef_cbl_z(j, 2, 2)*dvd(-2)
4362 poly(0) = v_rs_ws_z(j, k, l, i) &
4363 + poly_coef_cbl_z(j, 3, 0)*dvd(-1) &
4364 + poly_coef_cbl_z(j, 3, 1)*dvd(-2) &
4365 + poly_coef_cbl_z(j, 3, 2)*dvd(-3)
4366
4367 else
4368# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4369 ! (Fu, et al., 2016) Table 1
4370 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
4371 ! See Figure 2 (right) for right-sided flux (at i+1/2)
4372 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
4373 ! But we need to keep the stencil order to reuse the beta coefficients
4374 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
4375 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
4376 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
4377 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
4378 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
4379# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4380 end if
4381
4382 if (.not. teno) then
4383
4384 beta(3) = beta_coef_z(j, 0, 0)*dvd(2)*dvd(2) &
4385 + beta_coef_z(j, 0, 1)*dvd(2)*dvd(1) &
4386 + beta_coef_z(j, 0, 2)*dvd(2)*dvd(0) &
4387 + beta_coef_z(j, 0, 3)*dvd(1)*dvd(1) &
4388 + beta_coef_z(j, 0, 4)*dvd(1)*dvd(0) &
4389 + beta_coef_z(j, 0, 5)*dvd(0)*dvd(0) &
4390 + weno_eps
4391
4392 beta(2) = beta_coef_z(j, 1, 0)*dvd(1)*dvd(1) &
4393 + beta_coef_z(j, 1, 1)*dvd(1)*dvd(0) &
4394 + beta_coef_z(j, 1, 2)*dvd(1)*dvd(-1) &
4395 + beta_coef_z(j, 1, 3)*dvd(0)*dvd(0) &
4396 + beta_coef_z(j, 1, 4)*dvd(0)*dvd(-1) &
4397 + beta_coef_z(j, 1, 5)*dvd(-1)*dvd(-1) &
4398 + weno_eps
4399
4400 beta(1) = beta_coef_z(j, 2, 0)*dvd(0)*dvd(0) &
4401 + beta_coef_z(j, 2, 1)*dvd(0)*dvd(-1) &
4402 + beta_coef_z(j, 2, 2)*dvd(0)*dvd(-2) &
4403 + beta_coef_z(j, 2, 3)*dvd(-1)*dvd(-1) &
4404 + beta_coef_z(j, 2, 4)*dvd(-1)*dvd(-2) &
4405 + beta_coef_z(j, 2, 5)*dvd(-2)*dvd(-2) &
4406 + weno_eps
4407
4408 beta(0) = beta_coef_z(j, 3, 0)*dvd(-1)*dvd(-1) &
4409 + beta_coef_z(j, 3, 1)*dvd(-1)*dvd(-2) &
4410 + beta_coef_z(j, 3, 2)*dvd(-1)*dvd(-3) &
4411 + beta_coef_z(j, 3, 3)*dvd(-2)*dvd(-2) &
4412 + beta_coef_z(j, 3, 4)*dvd(-2)*dvd(-3) &
4413 + beta_coef_z(j, 3, 5)*dvd(-3)*dvd(-3) &
4414 + weno_eps
4415
4416 else ! TENO
4417# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4418 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
4419 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v( 0) + v( 1))**2._wp + (( v(-1) - v( 1))**2._wp)/4._wp + weno_eps !&
4420 beta(1) = 13._wp/12._wp*(v( 0) - 2._wp*v( 1) + v( 2))**2._wp + ((3._wp*v( 0) - 4._wp*v( 1) + v( 2))**2._wp)/4._wp + weno_eps !&
4421 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v( 0))**2._wp + (( v(-2) - 4._wp*v(-1) + 3._wp*v( 0))**2._wp)/4._wp + weno_eps !&
4422
4423 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
4424 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
4425 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
4426 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
4427 + weno_eps !&
4428
4429 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
4430 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
4431 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
4432 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
4433 + weno_eps !&
4434# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4435 end if
4436
4437 if (wenojs) then
4438 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4439
4440 elseif (mapped_weno) then
4441 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4442 omega = alpha/sum(alpha)
4443 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, j)*(1._wp + d_cbl_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4444 *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbl_z(0:weno_num_stencils, j))))
4445
4446 elseif (wenoz) then
4447 ! Castro, et al. (2010)
4448 ! Don & Borges (2013) also helps
4449 tau = abs(beta(3) - beta(0)) ! Equation 50
4450
4451# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4452#if defined(MFC_OpenACC)
4453# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4454!$acc loop seq
4455# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4456#elif defined(MFC_OpenMP)
4457# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4458
4459# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4460#endif
4461 do q = 0, weno_num_stencils
4462 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4463 end do
4464
4465 elseif (teno) then
4466# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4467 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4468 alpha = 1._wp + tau/beta
4469 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4470 omega = alpha/sum(alpha)
4471
4472
4473# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4474#if defined(MFC_OpenACC)
4475# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4476!$acc loop seq
4477# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4478#elif defined(MFC_OpenMP)
4479# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4480
4481# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4482#endif
4483 do q = 0, weno_num_stencils
4484 if (omega(q) < teno_ct) then ! Equation 26
4485 delta(q) = 0._wp
4486 else
4487 delta(q) = 1._wp
4488 end if
4489 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
4490 end do
4491# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4492 end if
4493
4494 omega = alpha/sum(alpha)
4495
4496 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4497
4498 if (teno) then
4499# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4500 vl_rs_vf_z(j, k, l, i) = vl_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
4501# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4502 end if
4503
4504 if (.not. teno) then
4505 poly(3) = v_rs_ws_z(j, k, l, i) &
4506 + poly_coef_cbr_z(j, 0, 0)*dvd(2) &
4507 + poly_coef_cbr_z(j, 0, 1)*dvd(1) &
4508 + poly_coef_cbr_z(j, 0, 2)*dvd(0)
4509 poly(2) = v_rs_ws_z(j, k, l, i) &
4510 + poly_coef_cbr_z(j, 1, 0)*dvd(1) &
4511 + poly_coef_cbr_z(j, 1, 1)*dvd(0) &
4512 + poly_coef_cbr_z(j, 1, 2)*dvd(-1)
4513 poly(1) = v_rs_ws_z(j, k, l, i) &
4514 + poly_coef_cbr_z(j, 2, 0)*dvd(0) &
4515 + poly_coef_cbr_z(j, 2, 1)*dvd(-1) &
4516 + poly_coef_cbr_z(j, 2, 2)*dvd(-2)
4517 poly(0) = v_rs_ws_z(j, k, l, i) &
4518 + poly_coef_cbr_z(j, 3, 0)*dvd(-1) &
4519 + poly_coef_cbr_z(j, 3, 1)*dvd(-2) &
4520 + poly_coef_cbr_z(j, 3, 2)*dvd(-3)
4521 else
4522# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4523 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
4524 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
4525 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
4526 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
4527 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
4528# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4529 end if
4530
4531 if (wenojs) then
4532 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4533
4534 elseif (mapped_weno) then
4535 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4536 omega = alpha/sum(alpha)
4537 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, j)*(1._wp + d_cbr_z(0:weno_num_stencils, j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4538 *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, j)**2._wp + omega(0:weno_num_stencils)*(1._wp - 2._wp*d_cbr_z(0:weno_num_stencils, j))))
4539
4540 elseif (wenoz) then
4541
4542
4543# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4544#if defined(MFC_OpenACC)
4545# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4546!$acc loop seq
4547# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4548#elif defined(MFC_OpenMP)
4549# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4550
4551# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4552#endif
4553 do q = 0, weno_num_stencils
4554 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4555 end do
4556
4557 elseif (teno) then
4558
4559# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4560#if defined(MFC_OpenACC)
4561# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4562!$acc loop seq
4563# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4564#elif defined(MFC_OpenMP)
4565# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4566
4567# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4568#endif
4569 do q = 0, weno_num_stencils
4570 alpha(q) = delta(q)*d_cbr_z(q, j)
4571 end do
4572 end if
4573
4574 omega = alpha/sum(alpha)
4575
4576 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4577
4578 if (teno) then
4579# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4580 vr_rs_vf_z(j, k, l, i) = vr_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
4581# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4582 end if
4583
4584 end do
4585 end do
4586 end do
4587 end do
4588
4589# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4590
4591# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4592#if defined(MFC_OpenACC)
4593# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4594!$acc end parallel loop
4595# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4596#elif defined(MFC_OpenMP)
4597# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4598
4599# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4600
4601# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4602!$omp end target teams loop
4603# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4604#endif
4605# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4606
4607 end if
4608# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4609# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4610 end if
4611
4612 if (int_comp) then
4613 call s_interface_compression(vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, &
4614 vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, &
4615 weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
4616 end if
4617
4618 end subroutine s_weno
4619
4620 !> The computation of parameters, the allocation of memory,
4621 !! the association of pointers and/or the execution of any
4622 !! other procedures that are required for the setup of the
4623 !! WENO reconstruction.
4624 !! @param v_vf Cell-averaged variables
4625 !! @param weno_dir Coordinate direction of the WENO reconstruction
4626 subroutine s_initialize_weno(v_vf, &
4627 weno_dir)
4628
4629 type(scalar_field), dimension(:), intent(IN) :: v_vf
4630
4631 integer, intent(IN) :: weno_dir
4632
4633 integer :: j, k, l, q
4634
4635 ! Determining the number of cell-average variables which will be
4636 ! WENO-reconstructed and mapping their indical bounds in the x-,
4637 ! y- and z-directions to those in the s1-, s2- and s3-directions
4638 ! as to reshape the inputted data in the coordinate direction of
4639 ! the WENO reconstruction
4640 v_size = ubound(v_vf, 1)
4641
4642# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4643#if defined(MFC_OpenACC)
4644# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4645!$acc update device(v_size)
4646# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4647#elif defined(MFC_OpenMP)
4648# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4649!$omp target update to(v_size)
4650# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4651#endif
4652
4653 if (weno_dir == 1) then
4654
4655# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4656
4657# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4658#if defined(MFC_OpenACC)
4659# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4660!$acc parallel loop collapse(4) gang vector default(present)
4661# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4662#elif defined(MFC_OpenMP)
4663# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4664
4665# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4666
4667# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4668
4669# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4670!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4671# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4672#endif
4673# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4674
4675 do j = 1, v_size
4676 do q = is3_weno%beg, is3_weno%end
4677 do l = is2_weno%beg, is2_weno%end
4678 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4679 v_rs_ws_x(k, l, q, j) = v_vf(j)%sf(k, l, q)
4680 end do
4681 end do
4682 end do
4683 end do
4684
4685# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4686
4687# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4688#if defined(MFC_OpenACC)
4689# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4690!$acc end parallel loop
4691# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4692#elif defined(MFC_OpenMP)
4693# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4694
4695# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4696
4697# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4698!$omp end target teams loop
4699# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4700#endif
4701# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4702
4703 end if
4704
4705 ! Reshaping/Projecting onto Characteristic Fields in y-direction
4706 if (n == 0) return
4707
4708 if (weno_dir == 2) then
4709
4710# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4711
4712# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4713#if defined(MFC_OpenACC)
4714# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4715!$acc parallel loop collapse(4) gang vector default(present)
4716# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4717#elif defined(MFC_OpenMP)
4718# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4719
4720# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4721
4722# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4723
4724# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4725!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4726# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4727#endif
4728# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4729
4730 do j = 1, v_size
4731 do q = is3_weno%beg, is3_weno%end
4732 do l = is2_weno%beg, is2_weno%end
4733 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4734 v_rs_ws_y(k, l, q, j) = v_vf(j)%sf(l, k, q)
4735 end do
4736 end do
4737 end do
4738 end do
4739
4740# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4741
4742# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4743#if defined(MFC_OpenACC)
4744# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4745!$acc end parallel loop
4746# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4747#elif defined(MFC_OpenMP)
4748# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4749
4750# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4751
4752# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4753!$omp end target teams loop
4754# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4755#endif
4756# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4757
4758 end if
4759
4760 ! Reshaping/Projecting onto Characteristic Fields in z-direction
4761 if (p == 0) return
4762
4763 if (weno_dir == 3) then
4764
4765# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4766
4767# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4768#if defined(MFC_OpenACC)
4769# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4770!$acc parallel loop collapse(4) gang vector default(present)
4771# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4772#elif defined(MFC_OpenMP)
4773# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4774
4775# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4776
4777# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4778
4779# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4780!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4781# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4782#endif
4783# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4784
4785 do j = 1, v_size
4786 do q = is3_weno%beg, is3_weno%end
4787 do l = is2_weno%beg, is2_weno%end
4788 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4789 v_rs_ws_z(k, l, q, j) = v_vf(j)%sf(q, l, k)
4790 end do
4791 end do
4792 end do
4793 end do
4794
4795# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4796
4797# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4798#if defined(MFC_OpenACC)
4799# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4800!$acc end parallel loop
4801# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4802#elif defined(MFC_OpenMP)
4803# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4804
4805# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4806
4807# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4808!$omp end target teams loop
4809# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4810#endif
4811# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4812
4813 end if
4814
4815 end subroutine s_initialize_weno
4816
4817 !> The goal of this subroutine is to ensure that the WENO
4818 !! reconstruction is monotonic. The latter is achieved by
4819 !! enforcing monotonicity preserving bounds of Suresh and
4820 !! Huynh (1997). The resulting MPWENO reconstruction, see
4821 !! Balsara and Shu (2000), ensures that the reconstructed
4822 !! values do not reside outside the range spanned by WENO
4823 !! stencil.
4824 !! @param v_rs_ws Reshaped cell-averaged variables
4825 !! @param vL_rs_vf Left WENO reconstructed cell-boundary values
4826 !! @param vR_rs_vf Right WENO reconstructed cell-boundary values
4827 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
4828
4829 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(IN) :: v_rs_ws
4830 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(INOUT) :: vL_rs_vf, vR_rs_vf
4831
4832 integer :: i, j, k, l
4833
4834 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
4835
4836 real(wp) :: d_MD, d_LC !<
4837 !! Median (md) curvature and large curvature (LC) measures
4838
4839 ! The left and right upper bounds (UL), medians, large curvatures,
4840 ! minima, and maxima of the WENO-reconstructed values of the cell-
4841 ! average variables.
4842 real(wp) :: vL_UL, vR_UL
4843 real(wp) :: vL_MD, vR_MD
4844 real(wp) :: vL_LC, vR_LC
4845 real(wp) :: vL_min, vR_min
4846 real(wp) :: vL_max, vR_max
4847
4848 real(wp), parameter :: alpha = 2._wp !>
4849 !! Determines the maximum Courant–Friedrichs–Lewy (CFL) number that
4850 !! may be utilized with the scheme. In theory, for stability, a CFL
4851 !! number less than 1/(1+alpha) is necessary. The default value for
4852 !! alpha is 2.
4853
4854 real(wp), parameter :: beta = 4._wp/3._wp !<
4855 !! Determines the amount of freedom available from utilizing a large
4856 !! value for the local curvature. The default value for beta is 4/3.
4857
4858 real(wp), parameter :: alpha_mp = 2._wp
4859 real(wp), parameter :: beta_mp = 4._wp/3._wp
4860
4861
4862# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4863
4864# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4865#if defined(MFC_OpenACC)
4866# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4867!$acc parallel loop collapse(4) gang vector default(present) private(d)
4868# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4869#elif defined(MFC_OpenMP)
4870# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4871
4872# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4873
4874# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4875
4876# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4877!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d)
4878# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4879#endif
4880# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4881
4882 do l = is3_weno%beg, is3_weno%end
4883 do k = is2_weno%beg, is2_weno%end
4884 do j = is1_weno%beg, is1_weno%end
4885 do i = 1, v_size
4886 d(-1) = v_rs_ws(j, k, l, i) &
4887 + v_rs_ws(j - 2, k, l, i) &
4888 - v_rs_ws(j - 1, k, l, i) &
4889 *2._wp
4890 d(0) = v_rs_ws(j + 1, k, l, i) &
4891 + v_rs_ws(j - 1, k, l, i) &
4892 - v_rs_ws(j, k, l, i) &
4893 *2._wp
4894 d(1) = v_rs_ws(j + 2, k, l, i) &
4895 + v_rs_ws(j, k, l, i) &
4896 - v_rs_ws(j + 1, k, l, i) &
4897 *2._wp
4898
4899 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) &
4900 *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) &
4901 *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) &
4902 *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
4903 abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
4904
4905 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) &
4906 *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) &
4907 *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) &
4908 *min(abs(4._wp*d(0) - d(1)), abs(d(0)), &
4909 abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
4910
4911 vl_ul = v_rs_ws(j, k, l, i) &
4912 - (v_rs_ws(j + 1, k, l, i) &
4913 - v_rs_ws(j, k, l, i))*alpha_mp
4914
4915 vl_md = (v_rs_ws(j, k, l, i) &
4916 + v_rs_ws(j - 1, k, l, i) &
4917 - d_md)*5.e-1_wp
4918
4919 vl_lc = v_rs_ws(j, k, l, i) &
4920 - (v_rs_ws(j + 1, k, l, i) &
4921 - v_rs_ws(j, k, l, i))*5.e-1_wp + beta_mp*d_lc
4922
4923 vl_min = max(min(v_rs_ws(j, k, l, i), &
4924 v_rs_ws(j - 1, k, l, i), &
4925 vl_md), &
4926 min(v_rs_ws(j, k, l, i), &
4927 vl_ul, &
4928 vl_lc))
4929
4930 vl_max = min(max(v_rs_ws(j, k, l, i), &
4931 v_rs_ws(j - 1, k, l, i), &
4932 vl_md), &
4933 max(v_rs_ws(j, k, l, i), &
4934 vl_ul, &
4935 vl_lc))
4936
4937 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) &
4938 + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, i)) &
4939 + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i))) &
4940 *min(abs(vl_min - vl_rs_vf(j, k, l, i)), &
4941 abs(vl_max - vl_rs_vf(j, k, l, i)))
4942 ! END: Left Monotonicity Preserving Bound
4943
4944 ! Right Monotonicity Preserving Bound
4945 d(-1) = v_rs_ws(j, k, l, i) &
4946 + v_rs_ws(j - 2, k, l, i) &
4947 - v_rs_ws(j - 1, k, l, i) &
4948 *2._wp
4949 d(0) = v_rs_ws(j + 1, k, l, i) &
4950 + v_rs_ws(j - 1, k, l, i) &
4951 - v_rs_ws(j, k, l, i) &
4952 *2._wp
4953 d(1) = v_rs_ws(j + 2, k, l, i) &
4954 + v_rs_ws(j, k, l, i) &
4955 - v_rs_ws(j + 1, k, l, i) &
4956 *2._wp
4957
4958 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) &
4959 *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) &
4960 *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) &
4961 *min(abs(4._wp*d(0) - d(1)), abs(d(0)), &
4962 abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
4963
4964 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) &
4965 *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) &
4966 *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) &
4967 *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
4968 abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
4969
4970 vr_ul = v_rs_ws(j, k, l, i) &
4971 + (v_rs_ws(j, k, l, i) &
4972 - v_rs_ws(j - 1, k, l, i))*alpha_mp
4973
4974 vr_md = (v_rs_ws(j, k, l, i) &
4975 + v_rs_ws(j + 1, k, l, i) &
4976 - d_md)*5.e-1_wp
4977
4978 vr_lc = v_rs_ws(j, k, l, i) &
4979 + (v_rs_ws(j, k, l, i) &
4980 - v_rs_ws(j - 1, k, l, i))*5.e-1_wp + beta_mp*d_lc
4981
4982 vr_min = max(min(v_rs_ws(j, k, l, i), &
4983 v_rs_ws(j + 1, k, l, i), &
4984 vr_md), &
4985 min(v_rs_ws(j, k, l, i), &
4986 vr_ul, &
4987 vr_lc))
4988
4989 vr_max = min(max(v_rs_ws(j, k, l, i), &
4990 v_rs_ws(j + 1, k, l, i), &
4991 vr_md), &
4992 max(v_rs_ws(j, k, l, i), &
4993 vr_ul, &
4994 vr_lc))
4995
4996 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) &
4997 + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, i)) &
4998 + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i))) &
4999 *min(abs(vr_min - vr_rs_vf(j, k, l, i)), &
5000 abs(vr_max - vr_rs_vf(j, k, l, i)))
5001 ! END: Right Monotonicity Preserving Bound
5002 end do
5003 end do
5004 end do
5005 end do
5006
5007# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5008
5009# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5010#if defined(MFC_OpenACC)
5011# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5012!$acc end parallel loop
5013# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5014#elif defined(MFC_OpenMP)
5015# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5016
5017# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5018
5019# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5020!$omp end target teams loop
5021# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5022#endif
5023# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5024
5025
5026 end subroutine s_preserve_monotonicity
5027
5028 !> Module deallocation and/or disassociation procedures
5029 impure subroutine s_finalize_weno_module()
5030
5031 if (weno_order == 1) return
5032
5033 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5034
5035 !deallocate(vL_rs_vf_x, vR_rs_vf_x)
5036#ifdef MFC_DEBUG
5037# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5038 block
5039# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5040 use iso_fortran_env, only: output_unit
5041# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5042
5043# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5044 print *, 'm_weno.fpp:1441: ', '@:DEALLOCATE(v_rs_ws_x)'
5045# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5046
5047# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5048 call flush (output_unit)
5049# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5050 end block
5051# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5052#endif
5053# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5054
5055# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5056#if defined(MFC_OpenACC)
5057# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5058!$acc exit data delete(v_rs_ws_x)
5059# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5060#elif defined(MFC_OpenMP)
5061# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5062!$omp target exit data map(release:v_rs_ws_x)
5063# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5064#endif
5065# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5066 deallocate (v_rs_ws_x)
5067
5068 ! Deallocating WENO coefficients in x-direction
5069#ifdef MFC_DEBUG
5070# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5071 block
5072# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5073 use iso_fortran_env, only: output_unit
5074# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5075
5076# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5077 print *, 'm_weno.fpp:1444: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5078# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5079
5080# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5081 call flush (output_unit)
5082# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5083 end block
5084# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5085#endif
5086# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5087
5088# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5089#if defined(MFC_OpenACC)
5090# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5091!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5092# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5093#elif defined(MFC_OpenMP)
5094# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5095!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5096# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5097#endif
5098# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5099 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5100#ifdef MFC_DEBUG
5101# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5102 block
5103# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5104 use iso_fortran_env, only: output_unit
5105# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5106
5107# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5108 print *, 'm_weno.fpp:1445: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5109# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5110
5111# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5112 call flush (output_unit)
5113# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5114 end block
5115# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5116#endif
5117# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5118
5119# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5120#if defined(MFC_OpenACC)
5121# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5122!$acc exit data delete(d_cbL_x, d_cbR_x)
5123# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5124#elif defined(MFC_OpenMP)
5125# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5127# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5128#endif
5129# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5130 deallocate (d_cbl_x, d_cbr_x)
5131#ifdef MFC_DEBUG
5132# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5133 block
5134# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5135 use iso_fortran_env, only: output_unit
5136# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5137
5138# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5139 print *, 'm_weno.fpp:1446: ', '@:DEALLOCATE(beta_coef_x)'
5140# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5141
5142# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5143 call flush (output_unit)
5144# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5145 end block
5146# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5147#endif
5148# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5149
5150# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5151#if defined(MFC_OpenACC)
5152# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5153!$acc exit data delete(beta_coef_x)
5154# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5155#elif defined(MFC_OpenMP)
5156# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5157!$omp target exit data map(release:beta_coef_x)
5158# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5159#endif
5160# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5161 deallocate (beta_coef_x)
5162
5163 ! Deallocating WENO coefficients in y-direction
5164 if (n == 0) return
5165
5166 !deallocate(vL_rs_vf_y, vR_rs_vf_y)
5167#ifdef MFC_DEBUG
5168# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5169 block
5170# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5171 use iso_fortran_env, only: output_unit
5172# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5173
5174# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5175 print *, 'm_weno.fpp:1452: ', '@:DEALLOCATE(v_rs_ws_y)'
5176# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5177
5178# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5179 call flush (output_unit)
5180# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5181 end block
5182# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5183#endif
5184# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5185
5186# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5187#if defined(MFC_OpenACC)
5188# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5189!$acc exit data delete(v_rs_ws_y)
5190# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5191#elif defined(MFC_OpenMP)
5192# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5193!$omp target exit data map(release:v_rs_ws_y)
5194# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5195#endif
5196# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5197 deallocate (v_rs_ws_y)
5198
5199#ifdef MFC_DEBUG
5200# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5201 block
5202# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5203 use iso_fortran_env, only: output_unit
5204# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5205
5206# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5207 print *, 'm_weno.fpp:1454: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5208# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5209
5210# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5211 call flush (output_unit)
5212# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5213 end block
5214# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5215#endif
5216# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217
5218# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219#if defined(MFC_OpenACC)
5220# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5222# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223#elif defined(MFC_OpenMP)
5224# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5225!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5226# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5227#endif
5228# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5229 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5230#ifdef MFC_DEBUG
5231# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5232 block
5233# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5234 use iso_fortran_env, only: output_unit
5235# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5236
5237# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5238 print *, 'm_weno.fpp:1455: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5239# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5240
5241# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5242 call flush (output_unit)
5243# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5244 end block
5245# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5246#endif
5247# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5248
5249# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5250#if defined(MFC_OpenACC)
5251# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5252!$acc exit data delete(d_cbL_y, d_cbR_y)
5253# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5254#elif defined(MFC_OpenMP)
5255# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5256!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5257# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5258#endif
5259# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5260 deallocate (d_cbl_y, d_cbr_y)
5261#ifdef MFC_DEBUG
5262# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5263 block
5264# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5265 use iso_fortran_env, only: output_unit
5266# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5267
5268# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5269 print *, 'm_weno.fpp:1456: ', '@:DEALLOCATE(beta_coef_y)'
5270# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5271
5272# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5273 call flush (output_unit)
5274# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5275 end block
5276# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5277#endif
5278# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5279
5280# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5281#if defined(MFC_OpenACC)
5282# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5283!$acc exit data delete(beta_coef_y)
5284# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5285#elif defined(MFC_OpenMP)
5286# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5287!$omp target exit data map(release:beta_coef_y)
5288# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5289#endif
5290# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5291 deallocate (beta_coef_y)
5292
5293 ! Deallocating WENO coefficients in z-direction
5294 if (p == 0) return
5295
5296 !deallocate(vL_rs_vf_z, vR_rs_vf_z)
5297#ifdef MFC_DEBUG
5298# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5299 block
5300# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5301 use iso_fortran_env, only: output_unit
5302# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5303
5304# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5305 print *, 'm_weno.fpp:1462: ', '@:DEALLOCATE(v_rs_ws_z)'
5306# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5307
5308# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5309 call flush (output_unit)
5310# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5311 end block
5312# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5313#endif
5314# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5315
5316# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5317#if defined(MFC_OpenACC)
5318# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5319!$acc exit data delete(v_rs_ws_z)
5320# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5321#elif defined(MFC_OpenMP)
5322# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5323!$omp target exit data map(release:v_rs_ws_z)
5324# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5325#endif
5326# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5327 deallocate (v_rs_ws_z)
5328
5329#ifdef MFC_DEBUG
5330# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5331 block
5332# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5333 use iso_fortran_env, only: output_unit
5334# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5335
5336# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5337 print *, 'm_weno.fpp:1464: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5338# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5339
5340# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5341 call flush (output_unit)
5342# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5343 end block
5344# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345#endif
5346# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5347
5348# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5349#if defined(MFC_OpenACC)
5350# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5351!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5352# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5353#elif defined(MFC_OpenMP)
5354# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5355!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
5356# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5357#endif
5358# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5359 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
5360#ifdef MFC_DEBUG
5361# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5362 block
5363# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5364 use iso_fortran_env, only: output_unit
5365# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5366
5367# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5368 print *, 'm_weno.fpp:1465: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
5369# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5370
5371# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5372 call flush (output_unit)
5373# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5374 end block
5375# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5376#endif
5377# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5378
5379# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5380#if defined(MFC_OpenACC)
5381# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5382!$acc exit data delete(d_cbL_z, d_cbR_z)
5383# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5384#elif defined(MFC_OpenMP)
5385# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5386!$omp target exit data map(release:d_cbL_z, d_cbR_z)
5387# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5388#endif
5389# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5390 deallocate (d_cbl_z, d_cbr_z)
5391#ifdef MFC_DEBUG
5392# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5393 block
5394# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5395 use iso_fortran_env, only: output_unit
5396# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5397
5398# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5399 print *, 'm_weno.fpp:1466: ', '@:DEALLOCATE(beta_coef_z)'
5400# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5401
5402# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5403 call flush (output_unit)
5404# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5405 end block
5406# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5407#endif
5408# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5409
5410# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5411#if defined(MFC_OpenACC)
5412# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5413!$acc exit data delete(beta_coef_z)
5414# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5415#elif defined(MFC_OpenMP)
5416# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5417!$omp target exit data map(release:beta_coef_z)
5418# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5419#endif
5420# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5421 deallocate (beta_coef_z)
5422
5423 end subroutine s_finalize_weno_module
5424
5425end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1121
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1121
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1121
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:292
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:303
m_global_parameters::weno_polyn
integer weno_polyn
Degree of the WENO polynomials (polyn).
Definition m_global_parameters.fpp.f90:432
m_global_parameters::buff_size
integer buff_size
The number of cells that are necessary to be able to store enough boundary conditions data to march t...
Definition m_global_parameters.fpp.f90:906
m_global_parameters::weno_order
integer weno_order
Order of the WENO reconstruction.
Definition m_global_parameters.fpp.f90:434
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:331
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:331
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:331
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:303
m_muscl
MUSCL reconstruction with interface sharpening for contact-preserving advection.
Definition m_muscl.fpp.f90:292
m_muscl::v_size
integer v_size
Definition m_muscl.fpp.f90:313
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:303
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:302
m_weno::beta_coef_y
real(wp), dimension(:, :, :), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:409
m_weno::beta_coef_z
real(wp), dimension(:, :, :), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:410
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:441
m_weno::poly_coef_cbl_x
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:348
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
The computation of parameters, the allocation of memory, the association of pointers and/or the execu...
Definition m_weno.fpp.f90:464
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:441
m_weno::d_cbl_z
real(wp), dimension(:, :), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:385
m_weno::d_cbl_y
real(wp), dimension(:, :), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:384
m_weno::poly_coef_cbr_x
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:351
m_weno::s_weno
subroutine, public s_weno(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, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
Performs WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
Definition m_weno.fpp.f90:2370
m_weno::d_cbr_x
real(wp), dimension(:, :), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:387
m_weno::beta_coef_x
real(wp), dimension(:, :, :), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:408
m_weno::poly_coef_cbl_y
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:349
m_weno::d_cbr_z
real(wp), dimension(:, :), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:389
m_weno::d_cbl_x
real(wp), dimension(:, :), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:383
m_weno::s_preserve_monotonicity
subroutine s_preserve_monotonicity(v_rs_ws, vl_rs_vf, vr_rs_vf)
The goal of this subroutine is to ensure that the WENO reconstruction is monotonic....
Definition m_weno.fpp.f90:4828
m_weno::v_rs_ws_z
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_z
Definition m_weno.fpp.f90:326
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:426
m_weno::v_rs_ws_x
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_x
Definition m_weno.fpp.f90:326
m_weno::d_cbr_y
real(wp), dimension(:, :), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:388
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:441
m_weno::poly_coef_cbl_z
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:350
m_weno::s_initialize_weno
subroutine, public s_initialize_weno(v_vf, weno_dir)
The computation of parameters, the allocation of memory, the association of pointers and/or the execu...
Definition m_weno.fpp.f90:4628
m_weno::s_compute_weno_coefficients
subroutine s_compute_weno_coefficients(weno_dir, is)
The purpose of this subroutine is to compute the grid dependent coefficients of the WENO polynomials,...
Definition m_weno.fpp.f90:1142
m_weno::poly_coef_cbr_z
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:353
m_weno::poly_coef_cbr_y
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:352
m_weno::v_rs_ws_y
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_y
Definition m_weno.fpp.f90:326
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5030
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:381