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# 104 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244# 119 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250# 171 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252# 182 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256# 204 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260# 225 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262# 236 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264# 246 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266# 252 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268# 258 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
269
270# 264 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272# 270 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274# 272 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
275# 273 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276! New line at end of file is required for FYPP
277# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
278
279# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
280
281! Caution:
282! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
283! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
284! For an example see misc/nvidia_uvm/bind.sh.
285# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
286
287# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
288
289# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
290
291# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
292
293# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
294
295# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
296
297# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
298
299# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300! New line at end of file is required for FYPP
301# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
302
303!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
304module m_weno
305
306 use m_derived_types !< definitions of the derived types
307
308 use m_global_parameters !< definitions of the global parameters
309
310 use m_variables_conversion !< state variables type conversion procedures
311
312 ! $:USE_GPU_MODULE()
313
314 use m_mpi_proxy
315
316 use m_muscl !< for interface compression
317
318 private; public :: s_initialize_weno_module, s_initialize_weno, s_finalize_weno_module, s_weno
319
320 !> @name The cell-average variables that will be WENO-reconstructed. Formerly, they
321 !! are stored in v_vf. However, they are transferred to v_rs_wsL and v_rs_wsR
322 !! as to be reshaped (RS) and/or characteristically decomposed. The reshaping
323 !! allows the WENO procedure to be independent of the coordinate direction of
324 !! the reconstruction. Lastly, notice that the left (L) and right (R) results
325 !! of the characteristic decomposition are stored in custom-constructed WENO-
326 !! stencils (WS) that are annexed to each position of a given scalar field.
327 !> @{
328 real(wp), allocatable, dimension(:, :, :, :) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z
329 !> @}
330
331# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
332#if defined(MFC_OpenACC)
333# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
334!$acc declare create(v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
335# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
336#elif defined(MFC_OpenMP)
337# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
338!$omp declare target (v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
339# 34 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
340#endif
341
342 ! WENO Coefficients
343
344 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at
345 !! the left and right quadrature points (QP), in the x-, y- and z-directions.
346 !! Note that the first dimension of the array identifies the polynomial, the
347 !! second dimension identifies the position of its coefficients and the last
348 !! dimension denotes the cell-location in the relevant coordinate direction.
349 !> @{
350 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_x
351 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_y
352 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbl_z
353 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_x
354 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_y
355 real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbr_z
356 !> @}
357
358# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
359#if defined(MFC_OpenACC)
360# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
361!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
362# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
363#elif defined(MFC_OpenMP)
364# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
365!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
366# 51 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
367#endif
368
369# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
370#if defined(MFC_OpenACC)
371# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
372!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
373# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
374#elif defined(MFC_OpenMP)
375# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
376!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
377# 52 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378#endif
379
380 !> @name The ideal weights at the left and the right cell-boundaries and at the
381 !! left and the right quadrature points, in x-, y- and z-directions. Note
382 !! that the first dimension of the array identifies the weight, while the
383 !! last denotes the cell-location in the relevant coordinate direction.
384 !> @{
385 real(wp), target, allocatable, dimension(:, :) :: d_cbl_x
386 real(wp), target, allocatable, dimension(:, :) :: d_cbl_y
387 real(wp), target, allocatable, dimension(:, :) :: d_cbl_z
388
389 real(wp), target, allocatable, dimension(:, :) :: d_cbr_x
390 real(wp), target, allocatable, dimension(:, :) :: d_cbr_y
391 real(wp), target, allocatable, dimension(:, :) :: d_cbr_z
392 !> @}
393
394# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
395#if defined(MFC_OpenACC)
396# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
397!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
398# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
399#elif defined(MFC_OpenMP)
400# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
401!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
402# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
403#endif
404
405 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note
406 !! that the first array dimension identifies the smoothness indicator, the
407 !! second identifies the position of its coefficients and the last denotes
408 !! the cell-location in the relevant coordinate direction.
409 !> @{
410 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_x
411 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_y
412 real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_z
413 !> @}
414
415# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416#if defined(MFC_OpenACC)
417# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
418!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
419# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
420#elif defined(MFC_OpenMP)
421# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
422!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
423# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
424#endif
425
426 ! END: WENO Coefficients
427
428 integer :: v_size !< Number of WENO-reconstructed cell-average variables
429
430# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
431#if defined(MFC_OpenACC)
432# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
433!$acc declare create(v_size)
434# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
435#elif defined(MFC_OpenMP)
436# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
437!$omp declare target (v_size)
438# 83 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
439#endif
440
441 !> @name Indical bounds in the s1-, s2- and s3-directions
442 !> @{
443 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
444#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
445
446# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447#if defined(MFC_OpenACC)
448# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449!$acc declare create(is1_weno, is2_weno, is3_weno)
450# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451#elif defined(MFC_OpenMP)
452# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
453!$omp declare target (is1_weno, is2_weno, is3_weno)
454# 89 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
455#endif
456#endif
457 !
458 !> @}
459
460contains
461
462 !> The computation of parameters, the allocation of memory,
463 !! the association of pointers and/or the execution of any
464 !! other procedures that are necessary to setup the module.
465 impure subroutine s_initialize_weno_module
466
467 if (weno_order == 1) return
468
469 ! Allocating/Computing WENO Coefficients in x-direction
470 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
471 if (n == 0) then
472 is2_weno%beg = 0
473 else
474 is2_weno%beg = -buff_size;
475 end if
476
477 is2_weno%end = n - is2_weno%beg
478
479 if (p == 0) then
480 is3_weno%beg = 0
481 else
482 is3_weno%beg = -buff_size
483 end if
484
485 is3_weno%end = p - is3_weno%beg
486
487#ifdef MFC_DEBUG
488# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
489 block
490# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
491 use iso_fortran_env, only: output_unit
492# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
493
494# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
495 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))'
496# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
497
498# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
499 call flush (output_unit)
500# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
501 end block
502# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
503#endif
504# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
505 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
510# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
511#if defined(MFC_OpenACC)
512# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
513!$acc enter data create(poly_coef_cbL_x)
514# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
515#elif defined(MFC_OpenMP)
516# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
517!$omp target enter data map(always,alloc:poly_coef_cbL_x)
518# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
519#endif
520# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
521#ifdef MFC_DEBUG
522# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
523 block
524# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
525 use iso_fortran_env, only: output_unit
526# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
527
528# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
529 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))'
530# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
531
532# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
533 call flush (output_unit)
534# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
535 end block
536# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
537#endif
538# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
539 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
544# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
545#if defined(MFC_OpenACC)
546# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
547!$acc enter data create(poly_coef_cbR_x)
548# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549#elif defined(MFC_OpenMP)
550# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551!$omp target enter data map(always,alloc:poly_coef_cbR_x)
552# 123 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553#endif
554# 125 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
555
556#ifdef MFC_DEBUG
557# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
558 block
559# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
560 use iso_fortran_env, only: output_unit
561# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
562
563# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
564 print *, 'm_weno.fpp:126: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
565# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
566
567# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
568 call flush (output_unit)
569# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
570 end block
571# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
572#endif
573# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
574 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
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
579# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
580#if defined(MFC_OpenACC)
581# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
582!$acc enter data create(d_cbL_x)
583# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
584#elif defined(MFC_OpenMP)
585# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
586!$omp target enter data map(always,alloc:d_cbL_x)
587# 126 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
588#endif
589#ifdef MFC_DEBUG
590# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591 block
592# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 use iso_fortran_env, only: output_unit
594# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595
596# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597 print *, 'm_weno.fpp:127: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
598# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599
600# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601 call flush (output_unit)
602# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603 end block
604# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605#endif
606# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
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
612# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613#if defined(MFC_OpenACC)
614# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
615!$acc enter data create(d_cbR_x)
616# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
617#elif defined(MFC_OpenMP)
618# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
619!$omp target enter data map(always,alloc:d_cbR_x)
620# 127 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
621#endif
622
623#ifdef MFC_DEBUG
624# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
625 block
626# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
627 use iso_fortran_env, only: output_unit
628# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
629
630# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
631 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))'
632# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
633
634# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
635 call flush (output_unit)
636# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
637 end block
638# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
639#endif
640# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
641 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))
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
646# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
647#if defined(MFC_OpenACC)
648# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
649!$acc enter data create(beta_coef_x)
650# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
651#elif defined(MFC_OpenMP)
652# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
653!$omp target enter data map(always,alloc:beta_coef_x)
654# 129 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
655#endif
656# 131 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
657 ! Number of cross terms for dvd = (k-1)(k-1+1)/2, where weno_polyn = k-1
658 ! Note: k-1 not k because we are using value differences (dvd) not the values themselves
659
660 call s_compute_weno_coefficients(1, is1_weno)
661
662#ifdef MFC_DEBUG
663# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664 block
665# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666 use iso_fortran_env, only: output_unit
667# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668
669# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670 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))'
671# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672
673# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674 call flush (output_unit)
675# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676 end block
677# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678#endif
679# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680 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))
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
685# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
686#if defined(MFC_OpenACC)
687# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
688!$acc enter data create(v_rs_ws_x)
689# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
690#elif defined(MFC_OpenMP)
691# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
692!$omp target enter data map(always,alloc:v_rs_ws_x)
693# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
694#endif
695# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
696
697 ! Allocating/Computing WENO Coefficients in y-direction
698 if (n == 0) return
699
700 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
701 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
702
703 if (p == 0) then
704 is3_weno%beg = 0
705 else
706 is3_weno%beg = -buff_size
707 end if
708
709 is3_weno%end = p - is3_weno%beg
710
711#ifdef MFC_DEBUG
712# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713 block
714# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715 use iso_fortran_env, only: output_unit
716# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717
718# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
719 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))'
720# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
721
722# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
723 call flush (output_unit)
724# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
725 end block
726# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
727#endif
728# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
729 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
734# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
735#if defined(MFC_OpenACC)
736# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737!$acc enter data create(poly_coef_cbL_y)
738# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739#elif defined(MFC_OpenMP)
740# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741!$omp target enter data map(always,alloc:poly_coef_cbL_y)
742# 153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743#endif
744# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745#ifdef MFC_DEBUG
746# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 block
748# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749 use iso_fortran_env, only: output_unit
750# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751
752# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753 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))'
754# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755
756# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757 call flush (output_unit)
758# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759 end block
760# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761#endif
762# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
768# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
769#if defined(MFC_OpenACC)
770# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
771!$acc enter data create(poly_coef_cbR_y)
772# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
773#elif defined(MFC_OpenMP)
774# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
775!$omp target enter data map(always,alloc:poly_coef_cbR_y)
776# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
777#endif
778# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
779
780#ifdef MFC_DEBUG
781# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782 block
783# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784 use iso_fortran_env, only: output_unit
785# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786
787# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788 print *, 'm_weno.fpp:158: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
789# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790
791# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792 call flush (output_unit)
793# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794 end block
795# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796#endif
797# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
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
803# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804#if defined(MFC_OpenACC)
805# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806!$acc enter data create(d_cbL_y)
807# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808#elif defined(MFC_OpenMP)
809# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810!$omp target enter data map(always,alloc:d_cbL_y)
811# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
812#endif
813#ifdef MFC_DEBUG
814# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
815 block
816# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
817 use iso_fortran_env, only: output_unit
818# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
819
820# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
821 print *, 'm_weno.fpp:159: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
822# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
823
824# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
825 call flush (output_unit)
826# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
827 end block
828# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
829#endif
830# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
831 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
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
836# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837#if defined(MFC_OpenACC)
838# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839!$acc enter data create(d_cbR_y)
840# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841#elif defined(MFC_OpenMP)
842# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843!$omp target enter data map(always,alloc:d_cbR_y)
844# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
845#endif
846
847#ifdef MFC_DEBUG
848# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849 block
850# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851 use iso_fortran_env, only: output_unit
852# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853
854# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855 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))'
856# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857
858# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859 call flush (output_unit)
860# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861 end block
862# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863#endif
864# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865 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))
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
870# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871#if defined(MFC_OpenACC)
872# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873!$acc enter data create(beta_coef_y)
874# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875#elif defined(MFC_OpenMP)
876# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877!$omp target enter data map(always,alloc:beta_coef_y)
878# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879#endif
880# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881
882 call s_compute_weno_coefficients(2, is2_weno)
883
884#ifdef MFC_DEBUG
885# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
886 block
887# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
888 use iso_fortran_env, only: output_unit
889# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
890
891# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
892 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))'
893# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
894
895# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
896 call flush (output_unit)
897# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
898 end block
899# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
900#endif
901# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
902 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))
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
907# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
908#if defined(MFC_OpenACC)
909# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
910!$acc enter data create(v_rs_ws_y)
911# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
912#elif defined(MFC_OpenMP)
913# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
914!$omp target enter data map(always,alloc:v_rs_ws_y)
915# 166 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
916#endif
917# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
918
919 ! Allocating/Computing WENO Coefficients in z-direction
920 if (p == 0) return
921
922 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
923 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
924 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
925
926#ifdef MFC_DEBUG
927# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
928 block
929# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
930 use iso_fortran_env, only: output_unit
931# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
932
933# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
934 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))'
935# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
936
937# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
938 call flush (output_unit)
939# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
940 end block
941# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
942#endif
943# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
944 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
949# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950#if defined(MFC_OpenACC)
951# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952!$acc enter data create(poly_coef_cbL_z)
953# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954#elif defined(MFC_OpenMP)
955# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956!$omp target enter data map(always,alloc:poly_coef_cbL_z)
957# 176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958#endif
959# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960#ifdef MFC_DEBUG
961# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962 block
963# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964 use iso_fortran_env, only: output_unit
965# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966
967# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968 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))'
969# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970
971# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972 call flush (output_unit)
973# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974 end block
975# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976#endif
977# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
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
983# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984#if defined(MFC_OpenACC)
985# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986!$acc enter data create(poly_coef_cbR_z)
987# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988#elif defined(MFC_OpenMP)
989# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990!$omp target enter data map(always,alloc:poly_coef_cbR_z)
991# 178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992#endif
993# 180 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994
995#ifdef MFC_DEBUG
996# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
997 block
998# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
999 use iso_fortran_env, only: output_unit
1000# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1001
1002# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1003 print *, 'm_weno.fpp:181: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1004# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1005
1006# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1007 call flush (output_unit)
1008# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1009 end block
1010# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1011#endif
1012# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1013 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
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
1018# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019#if defined(MFC_OpenACC)
1020# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021!$acc enter data create(d_cbL_z)
1022# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023#elif defined(MFC_OpenMP)
1024# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025!$omp target enter data map(always,alloc:d_cbL_z)
1026# 181 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027#endif
1028#ifdef MFC_DEBUG
1029# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1030 block
1031# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1032 use iso_fortran_env, only: output_unit
1033# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1034
1035# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1036 print *, 'm_weno.fpp:182: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1037# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1038
1039# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1040 call flush (output_unit)
1041# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1042 end block
1043# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1044#endif
1045# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1046 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
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
1051# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1052#if defined(MFC_OpenACC)
1053# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1054!$acc enter data create(d_cbR_z)
1055# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1056#elif defined(MFC_OpenMP)
1057# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1058!$omp target enter data map(always,alloc:d_cbR_z)
1059# 182 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1060#endif
1061
1062#ifdef MFC_DEBUG
1063# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1064 block
1065# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1066 use iso_fortran_env, only: output_unit
1067# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1068
1069# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1070 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))'
1071# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1072
1073# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1074 call flush (output_unit)
1075# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1076 end block
1077# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1078#endif
1079# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1080 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))
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
1085# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1086#if defined(MFC_OpenACC)
1087# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1088!$acc enter data create(beta_coef_z)
1089# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1090#elif defined(MFC_OpenMP)
1091# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1092!$omp target enter data map(always,alloc:beta_coef_z)
1093# 184 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1094#endif
1095# 186 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1096
1097 call s_compute_weno_coefficients(3, is3_weno)
1098
1099#ifdef MFC_DEBUG
1100# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1101 block
1102# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1103 use iso_fortran_env, only: output_unit
1104# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1105
1106# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1107 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))'
1108# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1109
1110# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1111 call flush (output_unit)
1112# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1113 end block
1114# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1115#endif
1116# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1117 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))
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
1122# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1123#if defined(MFC_OpenACC)
1124# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1125!$acc enter data create(v_rs_ws_z)
1126# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1127#elif defined(MFC_OpenMP)
1128# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1129!$omp target enter data map(always,alloc:v_rs_ws_z)
1130# 189 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1131#endif
1132# 191 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1133
1134 end subroutine s_initialize_weno_module
1135
1136 !> The purpose of this subroutine is to compute the grid
1137 !! dependent coefficients of the WENO polynomials, ideal
1138 !! weights and smoothness indicators, provided the order,
1139 !! the coordinate direction and the location of the WENO
1140 !! reconstruction.
1141 !! @param weno_dir Coordinate direction of the WENO reconstruction
1142 !! @param is Index bounds in the s-direction
1143 subroutine s_compute_weno_coefficients(weno_dir, is)
1144
1145 integer, intent(in) :: weno_dir
1146 type(int_bounds_info), intent(in) :: is
1147 integer :: s
1148
1149 real(wp), pointer, dimension(:) :: s_cb => null() !<
1150 !! Cell-boundary locations in the s-direction
1151
1152 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1153
1154 integer :: i !< Generic loop iterator
1155
1156 real(wp) :: w(1:8) ! Intermediate var for ideal weights: s_cb across overall stencil
1157 real(wp) :: y(1:4) ! Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1158
1159 ! Determining the number of cells, the cell-boundary locations and
1160 ! the boundary conditions in the coordinate direction selected for
1161 ! the WENO reconstruction
1162 if (weno_dir == 1) then
1163 s = m; s_cb => x_cb; bc_s = bc_x
1164 elseif (weno_dir == 2) then
1165 s = n; s_cb => y_cb; bc_s = bc_y
1166 else
1167 s = p; s_cb => z_cb; bc_s = bc_z
1168 end if
1169
1170# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1171 ! Computing WENO3 Coefficients
1172 if (weno_dir == 1) then
1173 if (weno_order == 3) then
1174 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1175
1176 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1177 (s_cb(i) - s_cb(i + 2))
1178 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1179 (s_cb(i - 1) - s_cb(i + 1))
1180
1181 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1182 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1183
1184 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1185 (s_cb(i - 1) - s_cb(i + 2))
1186 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1187 (s_cb(i - 1) - s_cb(i + 2))
1188
1189 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1190 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1191
1192 beta_coef_x(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1193 (s_cb(i) - s_cb(i + 2))**2._wp
1194 beta_coef_x(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1195 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1196
1197 end do
1198
1199 ! Modifying the ideal weights coefficients in the neighborhood
1200 ! of beginning and end Riemann state extrapolation BC to avoid
1201 ! any contributions from outside of the physical domain during
1202 ! the WENO reconstruction
1203 if (null_weights) then
1204 if (bc_s%beg == bc_riemann_extrap) then
1205 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1206 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1207 end if
1208
1209 if (bc_s%end == bc_riemann_extrap) then
1210 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1211 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1212 end if
1213 end if
1214 ! END: Computing WENO3 Coefficients
1215
1216 ! Computing WENO5 Coefficients
1217 elseif (weno_order == 5) then
1218
1219 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1220
1221 poly_coef_cbr_x(i + 1, 0, 0) = &
1222 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1223 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1224 poly_coef_cbr_x(i + 1, 1, 0) = &
1225 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1226 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1227 poly_coef_cbr_x(i + 1, 1, 1) = &
1228 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1229 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1230 poly_coef_cbr_x(i + 1, 2, 1) = &
1231 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1232 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1233 poly_coef_cbl_x(i + 1, 0, 0) = &
1234 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1235 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1236 poly_coef_cbl_x(i + 1, 1, 0) = &
1237 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
1238 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
1239 poly_coef_cbl_x(i + 1, 1, 1) = &
1240 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1241 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1242 poly_coef_cbl_x(i + 1, 2, 1) = &
1243 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
1244 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1245
1246 poly_coef_cbr_x(i + 1, 0, 1) = &
1247 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
1248 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1249 ((s_cb(i) - s_cb(i + 1)))
1250 poly_coef_cbr_x(i + 1, 2, 0) = &
1251 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1252 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
1253 ((s_cb(i + 1) - s_cb(i)))
1254 poly_coef_cbl_x(i + 1, 0, 1) = &
1255 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
1256 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1257 ((s_cb(i + 1) - s_cb(i)))
1258 poly_coef_cbl_x(i + 1, 2, 0) = &
1259 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1260 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
1261 ((s_cb(i) - s_cb(i + 1)))
1262
1263 d_cbr_x(0, i + 1) = &
1264 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1265 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1266 d_cbr_x(2, i + 1) = &
1267 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
1268 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1269 d_cbl_x(0, i + 1) = &
1270 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
1271 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1272 d_cbl_x(2, i + 1) = &
1273 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
1274 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1275
1276 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1277 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1278
1279 beta_coef_x(i + 1, 0, 0) = &
1280 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1281 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1282 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
1283 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1284
1285 beta_coef_x(i + 1, 0, 1) = &
1286 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1287 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
1288 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
1289 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
1290 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
1291 s_cb(i + 1)))
1292
1293 beta_coef_x(i + 1, 0, 2) = &
1294 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1295 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
1296 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
1297 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
1298 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1299
1300 beta_coef_x(i + 1, 1, 0) = &
1301 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1302 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1303 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
1304 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1305
1306 beta_coef_x(i + 1, 1, 1) = &
1307 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
1308 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
1309 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
1310 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
1311 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
1312 s_cb(i)))
1313
1314 beta_coef_x(i + 1, 1, 2) = &
1315 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1316 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1317 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
1318 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1319 s_cb(i + 2))**2._wp)
1320
1321 beta_coef_x(i + 1, 2, 0) = &
1322 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
1323 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
1324 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
1325 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
1326 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1327 s_cb(i + 1))**2._wp)
1328
1329 beta_coef_x(i + 1, 2, 1) = &
1330 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1331 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
1332 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
1333 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
1334 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
1335 s_cb(i - 1)))
1336
1337 beta_coef_x(i + 1, 2, 2) = &
1338 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1339 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1340 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
1341 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1342
1343 end do
1344
1345 ! Modifying the ideal weights coefficients in the neighborhood
1346 ! of beginning and end Riemann state extrapolation BC to avoid
1347 ! any contributions from outside of the physical domain during
1348 ! the WENO reconstruction
1349 if (null_weights) then
1350 if (bc_s%beg == bc_riemann_extrap) then
1351 d_cbr_x(1:2, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1352 d_cbl_x(1:2, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1353 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:, 1) = d_cbr_x(:, 1)/sum(d_cbr_x(:, 1))
1354 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:, 1) = d_cbl_x(:, 1)/sum(d_cbl_x(:, 1))
1355 end if
1356
1357 if (bc_s%end == bc_riemann_extrap) then
1358 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:, s - 1) = d_cbr_x(:, s - 1)/sum(d_cbr_x(:, s - 1))
1359 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:, s - 1) = d_cbl_x(:, s - 1)/sum(d_cbl_x(:, s - 1))
1360 d_cbr_x(0:1, s) = 0._wp; d_cbr_x(2, s) = 1._wp
1361 d_cbl_x(0:1, s) = 0._wp; d_cbl_x(2, s) = 1._wp
1362 end if
1363 end if
1364
1365 else ! WENO7
1366
1367 if (.not. teno) then
1368
1369 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1370
1371 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
1372 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
1373 ! Equation 2.61: Smoothness Indicators (beta_coef)
1374 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
1375 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
1376 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1377 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
1378 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
1379 ! using the cell value differences (dvd) instead of the values themselves.
1380 ! 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.
1381
1382 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1383 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))) !&
1384 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))) !&
1385 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))) !&
1386 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))) !&
1387
1388 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1389 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))) !&
1390 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))) !&
1391 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))) !&
1392 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))) !&
1393 ! Note: Left has the reversed order of both points and coefficients compared to the right
1394
1395 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1396 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))) !&
1397 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))) !&
1398 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))) !&
1399
1400 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1401 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))) !&
1402 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))) !&
1403 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))) !&
1404
1405 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1406 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))) !&
1407 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))) !&
1408 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))) !&
1409
1410 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1411 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))) !&
1412 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))) !&
1413 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))) !&
1414
1415 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1416 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))) !&
1417 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))) !&
1418 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))) !&
1419
1420 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1421 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))) !&
1422 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))) !&
1423 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))) !&
1424
1425 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1426 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))) !&
1427 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))) !&
1428 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))) !&
1429
1430 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1431 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))) !&
1432 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))) !&
1433 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))) !&
1434
1435 poly_coef_cbl_x(i + 1, :, :) = -poly_coef_cbl_x(i + 1, :, :)
1436 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1437
1438 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1439 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) & !&
1440 + 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 & !&
1441 + 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) !&
1442 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 & !&
1443 + 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 & !&
1444 + 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 & !&
1445 + 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 & !&
1446 + 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) !&
1447 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 & !&
1448 + 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)) & !&
1449 /(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) !&
1450 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 & !&
1451 + 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) & !&
1452 + 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 & !&
1453 + 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 & !&
1454 + 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) & !&
1455 + 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) & !&
1456 + 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) !&
1457 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) & !&
1458 + 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 & !&
1459 + 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 & !&
1460 + 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) !&
1461 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) & !&
1462 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1463
1464 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1465 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) & !&
1466 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1467 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 & !&
1468 + 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 & !&
1469 - 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 & !&
1470 - 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) !&
1471 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) & !&
1472 + 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) !&
1473 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 & !&
1474 + 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) & !&
1475 - 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 & !&
1476 + 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 & !&
1477 + 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 & !&
1478 + 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)) & !&
1479 /(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) !&
1480 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 & !&
1481 - 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 & !&
1482 - 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)) & !&
1483 /(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) !&
1484 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) !&
1485
1486 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1487 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) !&
1488 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) & !&
1489 + 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 & !&
1490 + 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)) & !&
1491 /(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) !&
1492 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) & !&
1493 + 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) !&
1494 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 & !&
1495 + 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 & !&
1496 + 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 & !&
1497 + 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) & !&
1498 + 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) & !&
1499 + 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 & !&
1500 + 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) !&
1501 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 & !&
1502 + 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 & !&
1503 + 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) & !&
1504 - 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) !&
1505 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) & !&
1506 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1507
1508 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1509 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) & !&
1510 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1511 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 & !&
1512 + 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) & !&
1513 + 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 & !&
1514 + 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) !&
1515 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 & !&
1516 + 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)) & !&
1517 /(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) !&
1518 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 & !&
1519 + 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 & !&
1520 + 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 & !&
1521 + 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 & !&
1522 + 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 & !&
1523 + 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 & !&
1524 + 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) !&
1525 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 & !&
1526 + 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 & !&
1527 + 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 & !&
1528 + 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 & !&
1529 + 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) !&
1530 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) & !&
1531 + 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) & !&
1532 + 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) !&
1533
1534 end do
1535
1536 else ! TENO (only supports uniform grid)
1537 ! (Fu, et al., 2016) Table 2 (for right flux)
1538 d_cbl_x(0, :) = 18._wp/35._wp
1539 d_cbl_x(1, :) = 3._wp/35._wp
1540 d_cbl_x(2, :) = 9._wp/35._wp
1541 d_cbl_x(3, :) = 1._wp/35._wp
1542 d_cbl_x(4, :) = 4._wp/35._wp
1543
1544 d_cbr_x(0, :) = 18._wp/35._wp
1545 d_cbr_x(1, :) = 9._wp/35._wp
1546 d_cbr_x(2, :) = 3._wp/35._wp
1547 d_cbr_x(3, :) = 4._wp/35._wp
1548 d_cbr_x(4, :) = 1._wp/35._wp
1549
1550 end if
1551 end if
1552
1553 end if
1554# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1555 ! Computing WENO3 Coefficients
1556 if (weno_dir == 2) then
1557 if (weno_order == 3) then
1558 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1559
1560 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1561 (s_cb(i) - s_cb(i + 2))
1562 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1563 (s_cb(i - 1) - s_cb(i + 1))
1564
1565 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1566 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1567
1568 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1569 (s_cb(i - 1) - s_cb(i + 2))
1570 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1571 (s_cb(i - 1) - s_cb(i + 2))
1572
1573 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1574 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1575
1576 beta_coef_y(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1577 (s_cb(i) - s_cb(i + 2))**2._wp
1578 beta_coef_y(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1579 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1580
1581 end do
1582
1583 ! Modifying the ideal weights coefficients in the neighborhood
1584 ! of beginning and end Riemann state extrapolation BC to avoid
1585 ! any contributions from outside of the physical domain during
1586 ! the WENO reconstruction
1587 if (null_weights) then
1588 if (bc_s%beg == bc_riemann_extrap) then
1589 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1590 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1591 end if
1592
1593 if (bc_s%end == bc_riemann_extrap) then
1594 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1595 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1596 end if
1597 end if
1598 ! END: Computing WENO3 Coefficients
1599
1600 ! Computing WENO5 Coefficients
1601 elseif (weno_order == 5) then
1602
1603 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1604
1605 poly_coef_cbr_y(i + 1, 0, 0) = &
1606 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1607 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1608 poly_coef_cbr_y(i + 1, 1, 0) = &
1609 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1610 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1611 poly_coef_cbr_y(i + 1, 1, 1) = &
1612 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1613 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1614 poly_coef_cbr_y(i + 1, 2, 1) = &
1615 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1616 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1617 poly_coef_cbl_y(i + 1, 0, 0) = &
1618 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1619 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1620 poly_coef_cbl_y(i + 1, 1, 0) = &
1621 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
1622 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
1623 poly_coef_cbl_y(i + 1, 1, 1) = &
1624 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
1625 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1626 poly_coef_cbl_y(i + 1, 2, 1) = &
1627 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
1628 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1629
1630 poly_coef_cbr_y(i + 1, 0, 1) = &
1631 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
1632 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1633 ((s_cb(i) - s_cb(i + 1)))
1634 poly_coef_cbr_y(i + 1, 2, 0) = &
1635 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1636 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
1637 ((s_cb(i + 1) - s_cb(i)))
1638 poly_coef_cbl_y(i + 1, 0, 1) = &
1639 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
1640 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
1641 ((s_cb(i + 1) - s_cb(i)))
1642 poly_coef_cbl_y(i + 1, 2, 0) = &
1643 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
1644 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
1645 ((s_cb(i) - s_cb(i + 1)))
1646
1647 d_cbr_y(0, i + 1) = &
1648 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
1649 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1650 d_cbr_y(2, i + 1) = &
1651 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
1652 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1653 d_cbl_y(0, i + 1) = &
1654 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
1655 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1656 d_cbl_y(2, i + 1) = &
1657 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
1658 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1659
1660 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1661 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1662
1663 beta_coef_y(i + 1, 0, 0) = &
1664 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1665 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1666 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
1667 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1668
1669 beta_coef_y(i + 1, 0, 1) = &
1670 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1671 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
1672 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
1673 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
1674 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
1675 s_cb(i + 1)))
1676
1677 beta_coef_y(i + 1, 0, 2) = &
1678 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1679 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
1680 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
1681 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
1682 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1683
1684 beta_coef_y(i + 1, 1, 0) = &
1685 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1686 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1687 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
1688 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1689
1690 beta_coef_y(i + 1, 1, 1) = &
1691 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
1692 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
1693 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
1694 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
1695 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
1696 s_cb(i)))
1697
1698 beta_coef_y(i + 1, 1, 2) = &
1699 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1700 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
1701 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
1702 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1703 s_cb(i + 2))**2._wp)
1704
1705 beta_coef_y(i + 1, 2, 0) = &
1706 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
1707 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
1708 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
1709 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
1710 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
1711 s_cb(i + 1))**2._wp)
1712
1713 beta_coef_y(i + 1, 2, 1) = &
1714 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
1715 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
1716 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
1717 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
1718 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
1719 s_cb(i - 1)))
1720
1721 beta_coef_y(i + 1, 2, 2) = &
1722 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
1723 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
1724 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
1725 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1726
1727 end do
1728
1729 ! Modifying the ideal weights coefficients in the neighborhood
1730 ! of beginning and end Riemann state extrapolation BC to avoid
1731 ! any contributions from outside of the physical domain during
1732 ! the WENO reconstruction
1733 if (null_weights) then
1734 if (bc_s%beg == bc_riemann_extrap) then
1735 d_cbr_y(1:2, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1736 d_cbl_y(1:2, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1737 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:, 1) = d_cbr_y(:, 1)/sum(d_cbr_y(:, 1))
1738 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:, 1) = d_cbl_y(:, 1)/sum(d_cbl_y(:, 1))
1739 end if
1740
1741 if (bc_s%end == bc_riemann_extrap) then
1742 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:, s - 1) = d_cbr_y(:, s - 1)/sum(d_cbr_y(:, s - 1))
1743 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:, s - 1) = d_cbl_y(:, s - 1)/sum(d_cbl_y(:, s - 1))
1744 d_cbr_y(0:1, s) = 0._wp; d_cbr_y(2, s) = 1._wp
1745 d_cbl_y(0:1, s) = 0._wp; d_cbl_y(2, s) = 1._wp
1746 end if
1747 end if
1748
1749 else ! WENO7
1750
1751 if (.not. teno) then
1752
1753 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1754
1755 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
1756 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
1757 ! Equation 2.61: Smoothness Indicators (beta_coef)
1758 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
1759 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
1760 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1761 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
1762 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
1763 ! using the cell value differences (dvd) instead of the values themselves.
1764 ! 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.
1765
1766 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1767 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))) !&
1768 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))) !&
1769 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))) !&
1770 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))) !&
1771
1772 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1773 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))) !&
1774 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))) !&
1775 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))) !&
1776 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))) !&
1777 ! Note: Left has the reversed order of both points and coefficients compared to the right
1778
1779 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1780 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))) !&
1781 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))) !&
1782 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))) !&
1783
1784 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1785 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))) !&
1786 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))) !&
1787 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))) !&
1788
1789 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1790 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))) !&
1791 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))) !&
1792 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))) !&
1793
1794 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1795 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))) !&
1796 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))) !&
1797 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))) !&
1798
1799 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1800 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))) !&
1801 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))) !&
1802 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))) !&
1803
1804 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1805 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))) !&
1806 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))) !&
1807 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))) !&
1808
1809 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1810 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))) !&
1811 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))) !&
1812 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))) !&
1813
1814 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1815 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))) !&
1816 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))) !&
1817 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))) !&
1818
1819 poly_coef_cbl_y(i + 1, :, :) = -poly_coef_cbl_y(i + 1, :, :)
1820 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1821
1822 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1823 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) & !&
1824 + 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 & !&
1825 + 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) !&
1826 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 & !&
1827 + 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 & !&
1828 + 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 & !&
1829 + 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 & !&
1830 + 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) !&
1831 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 & !&
1832 + 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)) & !&
1833 /(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) !&
1834 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 & !&
1835 + 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) & !&
1836 + 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 & !&
1837 + 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 & !&
1838 + 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) & !&
1839 + 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) & !&
1840 + 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) !&
1841 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) & !&
1842 + 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 & !&
1843 + 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 & !&
1844 + 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) !&
1845 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) & !&
1846 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1847
1848 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1849 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) & !&
1850 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1851 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 & !&
1852 + 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 & !&
1853 - 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 & !&
1854 - 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) !&
1855 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) & !&
1856 + 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) !&
1857 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 & !&
1858 + 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) & !&
1859 - 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 & !&
1860 + 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 & !&
1861 + 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 & !&
1862 + 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)) & !&
1863 /(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) !&
1864 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 & !&
1865 - 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 & !&
1866 - 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)) & !&
1867 /(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) !&
1868 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) !&
1869
1870 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1871 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) !&
1872 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) & !&
1873 + 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 & !&
1874 + 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)) & !&
1875 /(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) !&
1876 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) & !&
1877 + 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) !&
1878 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 & !&
1879 + 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 & !&
1880 + 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 & !&
1881 + 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) & !&
1882 + 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) & !&
1883 + 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 & !&
1884 + 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) !&
1885 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 & !&
1886 + 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 & !&
1887 + 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) & !&
1888 - 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) !&
1889 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) & !&
1890 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1891
1892 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1893 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) & !&
1894 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
1895 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 & !&
1896 + 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) & !&
1897 + 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 & !&
1898 + 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) !&
1899 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 & !&
1900 + 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)) & !&
1901 /(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) !&
1902 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 & !&
1903 + 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 & !&
1904 + 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 & !&
1905 + 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 & !&
1906 + 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 & !&
1907 + 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 & !&
1908 + 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) !&
1909 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 & !&
1910 + 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 & !&
1911 + 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 & !&
1912 + 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 & !&
1913 + 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) !&
1914 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) & !&
1915 + 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) & !&
1916 + 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) !&
1917
1918 end do
1919
1920 else ! TENO (only supports uniform grid)
1921 ! (Fu, et al., 2016) Table 2 (for right flux)
1922 d_cbl_y(0, :) = 18._wp/35._wp
1923 d_cbl_y(1, :) = 3._wp/35._wp
1924 d_cbl_y(2, :) = 9._wp/35._wp
1925 d_cbl_y(3, :) = 1._wp/35._wp
1926 d_cbl_y(4, :) = 4._wp/35._wp
1927
1928 d_cbr_y(0, :) = 18._wp/35._wp
1929 d_cbr_y(1, :) = 9._wp/35._wp
1930 d_cbr_y(2, :) = 3._wp/35._wp
1931 d_cbr_y(3, :) = 4._wp/35._wp
1932 d_cbr_y(4, :) = 1._wp/35._wp
1933
1934 end if
1935 end if
1936
1937 end if
1938# 229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1939 ! Computing WENO3 Coefficients
1940 if (weno_dir == 3) then
1941 if (weno_order == 3) then
1942 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1943
1944 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/ &
1945 (s_cb(i) - s_cb(i + 2))
1946 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/ &
1947 (s_cb(i - 1) - s_cb(i + 1))
1948
1949 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
1950 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
1951
1952 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/ &
1953 (s_cb(i - 1) - s_cb(i + 2))
1954 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/ &
1955 (s_cb(i - 1) - s_cb(i + 2))
1956
1957 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
1958 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
1959
1960 beta_coef_z(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1961 (s_cb(i) - s_cb(i + 2))**2._wp
1962 beta_coef_z(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ &
1963 (s_cb(i - 1) - s_cb(i + 1))**2._wp
1964
1965 end do
1966
1967 ! Modifying the ideal weights coefficients in the neighborhood
1968 ! of beginning and end Riemann state extrapolation BC to avoid
1969 ! any contributions from outside of the physical domain during
1970 ! the WENO reconstruction
1971 if (null_weights) then
1972 if (bc_s%beg == bc_riemann_extrap) then
1973 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
1974 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
1975 end if
1976
1977 if (bc_s%end == bc_riemann_extrap) then
1978 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
1979 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
1980 end if
1981 end if
1982 ! END: Computing WENO3 Coefficients
1983
1984 ! Computing WENO5 Coefficients
1985 elseif (weno_order == 5) then
1986
1987 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1988
1989 poly_coef_cbr_z(i + 1, 0, 0) = &
1990 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1991 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1992 poly_coef_cbr_z(i + 1, 1, 0) = &
1993 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/ &
1994 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1995 poly_coef_cbr_z(i + 1, 1, 1) = &
1996 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/ &
1997 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1998 poly_coef_cbr_z(i + 1, 2, 1) = &
1999 ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
2000 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2001 poly_coef_cbl_z(i + 1, 0, 0) = &
2002 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
2003 ((s_cb(i) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2004 poly_coef_cbl_z(i + 1, 1, 0) = &
2005 ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/ &
2006 ((s_cb(i - 1) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 2)))
2007 poly_coef_cbl_z(i + 1, 1, 1) = &
2008 ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/ &
2009 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2010 poly_coef_cbl_z(i + 1, 2, 1) = &
2011 ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/ &
2012 ((s_cb(i - 2) - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2013
2014 poly_coef_cbr_z(i + 1, 0, 1) = &
2015 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/ &
2016 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
2017 ((s_cb(i) - s_cb(i + 1)))
2018 poly_coef_cbr_z(i + 1, 2, 0) = &
2019 ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
2020 ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))* &
2021 ((s_cb(i + 1) - s_cb(i)))
2022 poly_coef_cbl_z(i + 1, 0, 1) = &
2023 ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/ &
2024 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))* &
2025 ((s_cb(i + 1) - s_cb(i)))
2026 poly_coef_cbl_z(i + 1, 2, 0) = &
2027 ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/ &
2028 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))* &
2029 ((s_cb(i) - s_cb(i + 1)))
2030
2031 d_cbr_z(0, i + 1) = &
2032 ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/ &
2033 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2034 d_cbr_z(2, i + 1) = &
2035 ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/ &
2036 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2037 d_cbl_z(0, i + 1) = &
2038 ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/ &
2039 ((s_cb(i - 2) - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2040 d_cbl_z(2, i + 1) = &
2041 ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ &
2042 ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2043
2044 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2045 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2046
2047 beta_coef_z(i + 1, 0, 0) = &
2048 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2049 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
2050 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - &
2051 s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2052
2053 beta_coef_z(i + 1, 0, 1) = &
2054 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
2055 s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - &
2056 s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - &
2057 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - &
2058 s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - &
2059 s_cb(i + 1)))
2060
2061 beta_coef_z(i + 1, 0, 2) = &
2062 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2063 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - &
2064 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - &
2065 s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - &
2066 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2067
2068 beta_coef_z(i + 1, 1, 0) = &
2069 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2070 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
2071 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - &
2072 s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2073
2074 beta_coef_z(i + 1, 1, 1) = &
2075 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - &
2076 s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - &
2077 s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - &
2078 s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - &
2079 s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - &
2080 s_cb(i)))
2081
2082 beta_coef_z(i + 1, 1, 2) = &
2083 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2084 s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - &
2085 s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ &
2086 ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
2087 s_cb(i + 2))**2._wp)
2088
2089 beta_coef_z(i + 1, 2, 0) = &
2090 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - &
2091 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - &
2092 s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + &
2093 (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ &
2094 ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - &
2095 s_cb(i + 1))**2._wp)
2096
2097 beta_coef_z(i + 1, 2, 1) = &
2098 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - &
2099 s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - &
2100 s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - &
2101 s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - &
2102 s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - &
2103 s_cb(i - 1)))
2104
2105 beta_coef_z(i + 1, 2, 2) = &
2106 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - &
2107 s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - &
2108 s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - &
2109 s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2110
2111 end do
2112
2113 ! Modifying the ideal weights coefficients in the neighborhood
2114 ! of beginning and end Riemann state extrapolation BC to avoid
2115 ! any contributions from outside of the physical domain during
2116 ! the WENO reconstruction
2117 if (null_weights) then
2118 if (bc_s%beg == bc_riemann_extrap) then
2119 d_cbr_z(1:2, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2120 d_cbl_z(1:2, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2121 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:, 1) = d_cbr_z(:, 1)/sum(d_cbr_z(:, 1))
2122 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:, 1) = d_cbl_z(:, 1)/sum(d_cbl_z(:, 1))
2123 end if
2124
2125 if (bc_s%end == bc_riemann_extrap) then
2126 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:, s - 1) = d_cbr_z(:, s - 1)/sum(d_cbr_z(:, s - 1))
2127 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:, s - 1) = d_cbl_z(:, s - 1)/sum(d_cbl_z(:, s - 1))
2128 d_cbr_z(0:1, s) = 0._wp; d_cbr_z(2, s) = 1._wp
2129 d_cbl_z(0:1, s) = 0._wp; d_cbl_z(2, s) = 1._wp
2130 end if
2131 end if
2132
2133 else ! WENO7
2134
2135 if (.not. teno) then
2136
2137 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2138
2139 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes for Hyperbolic Conservation Laws"
2140 ! Equation 2.20: Polynomial Coefficients (poly_coef_cb)
2141 ! Equation 2.61: Smoothness Indicators (beta_coef)
2142 ! To reduce computational cost, we leverage the fact that all polynomial coefficients in a stencil sum to 1
2143 ! and compute the polynomial coefficients (poly_coef_cb) for the cell value differences (dvd) instead of the values themselves.
2144 ! The computation of coefficients is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2145 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial coefficients.
2146 ! The smoothness indicators (beta_coef) are calculated through numerical differentiation and integration of each cross term of the polynomial coefficients,
2147 ! using the cell value differences (dvd) instead of the values themselves.
2148 ! 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.
2149
2150 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2151 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))) !&
2152 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))) !&
2153 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))) !&
2154 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))) !&
2155
2156 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2157 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))) !&
2158 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))) !&
2159 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))) !&
2160 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))) !&
2161 ! Note: Left has the reversed order of both points and coefficients compared to the right
2162
2163 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2164 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))) !&
2165 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))) !&
2166 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))) !&
2167
2168 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2169 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))) !&
2170 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))) !&
2171 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))) !&
2172
2173 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2174 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))) !&
2175 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))) !&
2176 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))) !&
2177
2178 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2179 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))) !&
2180 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))) !&
2181 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))) !&
2182
2183 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2184 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))) !&
2185 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))) !&
2186 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))) !&
2187
2188 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2189 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))) !&
2190 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))) !&
2191 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))) !&
2192
2193 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2194 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))) !&
2195 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))) !&
2196 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))) !&
2197
2198 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2199 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))) !&
2200 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))) !&
2201 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))) !&
2202
2203 poly_coef_cbl_z(i + 1, :, :) = -poly_coef_cbl_z(i + 1, :, :)
2204 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2205
2206 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2207 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) & !&
2208 + 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 & !&
2209 + 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) !&
2210 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 & !&
2211 + 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 & !&
2212 + 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 & !&
2213 + 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 & !&
2214 + 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) !&
2215 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 & !&
2216 + 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)) & !&
2217 /(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) !&
2218 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 & !&
2219 + 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) & !&
2220 + 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 & !&
2221 + 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 & !&
2222 + 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) & !&
2223 + 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) & !&
2224 + 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) !&
2225 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) & !&
2226 + 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 & !&
2227 + 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 & !&
2228 + 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) !&
2229 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) & !&
2230 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2231
2232 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2233 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) & !&
2234 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2235 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 & !&
2236 + 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 & !&
2237 - 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 & !&
2238 - 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) !&
2239 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) & !&
2240 + 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) !&
2241 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 & !&
2242 + 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) & !&
2243 - 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 & !&
2244 + 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 & !&
2245 + 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 & !&
2246 + 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)) & !&
2247 /(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) !&
2248 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 & !&
2249 - 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 & !&
2250 - 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)) & !&
2251 /(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) !&
2252 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) !&
2253
2254 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2255 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) !&
2256 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) & !&
2257 + 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 & !&
2258 + 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)) & !&
2259 /(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) !&
2260 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) & !&
2261 + 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) !&
2262 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 & !&
2263 + 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 & !&
2264 + 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 & !&
2265 + 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) & !&
2266 + 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) & !&
2267 + 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 & !&
2268 + 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) !&
2269 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 & !&
2270 + 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 & !&
2271 + 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) & !&
2272 - 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) !&
2273 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) & !&
2274 + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2275
2276 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2277 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) & !&
2278 + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) !&
2279 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 & !&
2280 + 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) & !&
2281 + 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 & !&
2282 + 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) !&
2283 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 & !&
2284 + 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)) & !&
2285 /(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) !&
2286 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 & !&
2287 + 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 & !&
2288 + 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 & !&
2289 + 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 & !&
2290 + 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 & !&
2291 + 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 & !&
2292 + 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) !&
2293 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 & !&
2294 + 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 & !&
2295 + 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 & !&
2296 + 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 & !&
2297 + 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) !&
2298 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) & !&
2299 + 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) & !&
2300 + 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) !&
2301
2302 end do
2303
2304 else ! TENO (only supports uniform grid)
2305 ! (Fu, et al., 2016) Table 2 (for right flux)
2306 d_cbl_z(0, :) = 18._wp/35._wp
2307 d_cbl_z(1, :) = 3._wp/35._wp
2308 d_cbl_z(2, :) = 9._wp/35._wp
2309 d_cbl_z(3, :) = 1._wp/35._wp
2310 d_cbl_z(4, :) = 4._wp/35._wp
2311
2312 d_cbr_z(0, :) = 18._wp/35._wp
2313 d_cbr_z(1, :) = 9._wp/35._wp
2314 d_cbr_z(2, :) = 3._wp/35._wp
2315 d_cbr_z(3, :) = 4._wp/35._wp
2316 d_cbr_z(4, :) = 1._wp/35._wp
2317
2318 end if
2319 end if
2320
2321 end if
2322# 613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2323
2324 if (weno_dir == 1) then
2325
2326# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2327#if defined(MFC_OpenACC)
2328# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2329!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
2330# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2331#elif defined(MFC_OpenMP)
2332# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2333!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
2334# 615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2335#endif
2336 elseif (weno_dir == 2) then
2337
2338# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2339#if defined(MFC_OpenACC)
2340# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2341!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
2342# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2343#elif defined(MFC_OpenMP)
2344# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2345!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
2346# 617 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2347#endif
2348 else
2349
2350# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2351#if defined(MFC_OpenACC)
2352# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2353!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
2354# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2355#elif defined(MFC_OpenMP)
2356# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2357!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
2358# 619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2359#endif
2360 end if
2361
2362 ! Nullifying WENO coefficients and cell-boundary locations pointers
2363
2364 nullify (s_cb)
2365
2366 end subroutine s_compute_weno_coefficients
2367
2368 !> @brief Performs WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
2369 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, &
2370 weno_dir, &
2371 is1_weno_d, is2_weno_d, is3_weno_d)
2372
2373 type(scalar_field), dimension(1:), intent(in) :: v_vf
2374 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
2375 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
2376 integer, intent(in) :: weno_dir
2377 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
2378
2379# 647 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2380 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
2381 real(wp), dimension(0:weno_num_stencils) :: poly
2382 real(wp), dimension(0:weno_num_stencils) :: alpha
2383 real(wp), dimension(0:weno_num_stencils) :: omega
2384 real(wp), dimension(0:weno_num_stencils) :: beta
2385 real(wp), dimension(0:weno_num_stencils) :: delta
2386# 654 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2387 real(wp), dimension(-3:3) :: v ! temporary field value array for clarity (WENO7 only)
2388 real(wp) :: tau
2389
2390 integer :: i, j, k, l, q
2391
2392 is1_weno = is1_weno_d
2393 is2_weno = is2_weno_d
2394 is3_weno = is3_weno_d
2395
2396
2397# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2398#if defined(MFC_OpenACC)
2399# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2400!$acc update device(is1_weno, is2_weno, is3_weno)
2401# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2402#elif defined(MFC_OpenMP)
2403# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2404!$omp target update to(is1_weno, is2_weno, is3_weno)
2405# 663 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2406#endif
2407
2408 if (weno_order /= 1 .or. dummy) then
2409 call s_initialize_weno(v_vf, &
2410 weno_dir)
2411 end if
2412
2413 if (weno_order == 1 .or. dummy) then
2414 if (weno_dir == 1) then
2415
2416# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2417
2418# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2419#if defined(MFC_OpenACC)
2420# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2421!$acc parallel loop collapse(4) gang vector default(present)
2422# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2423#elif defined(MFC_OpenMP)
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
2430# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2431!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2432# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2433#endif
2434# 672 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2435
2436 do i = 1, ubound(v_vf, 1)
2437 do l = is3_weno%beg, is3_weno%end
2438 do k = is2_weno%beg, is2_weno%end
2439 do j = is1_weno%beg, is1_weno%end
2440 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
2441 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
2442 end do
2443 end do
2444 end do
2445 end do
2446
2447# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2448
2449# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2450#if defined(MFC_OpenACC)
2451# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2452!$acc end parallel loop
2453# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2454#elif defined(MFC_OpenMP)
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
2459# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2460!$omp end target teams loop
2461# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2462#endif
2463# 683 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2464
2465 else if (weno_dir == 2) then
2466
2467# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2468
2469# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2470#if defined(MFC_OpenACC)
2471# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2472!$acc parallel loop collapse(4) gang vector default(present)
2473# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2474#elif defined(MFC_OpenMP)
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
2481# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2482!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2483# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2484#endif
2485# 685 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2486
2487 do i = 1, ubound(v_vf, 1)
2488 do l = is3_weno%beg, is3_weno%end
2489 do k = is2_weno%beg, is2_weno%end
2490 do j = is1_weno%beg, is1_weno%end
2491 vl_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
2492 vr_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
2493 end do
2494 end do
2495 end do
2496 end do
2497
2498# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2499
2500# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2501#if defined(MFC_OpenACC)
2502# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2503!$acc end parallel loop
2504# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2505#elif defined(MFC_OpenMP)
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
2510# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2511!$omp end target teams loop
2512# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2513#endif
2514# 696 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2515
2516 else if (weno_dir == 3) then
2517
2518# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2519
2520# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2521#if defined(MFC_OpenACC)
2522# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2523!$acc parallel loop collapse(4) gang vector default(present)
2524# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2525#elif defined(MFC_OpenMP)
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
2532# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2533!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
2534# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2535#endif
2536# 698 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2537
2538 do i = 1, ubound(v_vf, 1)
2539 do l = is3_weno%beg, is3_weno%end
2540 do k = is2_weno%beg, is2_weno%end
2541 do j = is1_weno%beg, is1_weno%end
2542 vl_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
2543 vr_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
2544 end do
2545 end do
2546 end do
2547 end do
2548
2549# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2550
2551# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2552#if defined(MFC_OpenACC)
2553# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2554!$acc end parallel loop
2555# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2556#elif defined(MFC_OpenMP)
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
2561# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2562!$omp end target teams loop
2563# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2564#endif
2565# 709 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2566
2567 end if
2568 end if
2569 if (weno_order == 3 .or. dummy) then
2570# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2571 if (weno_dir == 1) then
2572
2573# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2574
2575# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2576#if defined(MFC_OpenACC)
2577# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2578!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2579# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2580#elif defined(MFC_OpenMP)
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
2587# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2588!$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)
2589# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2590#endif
2591# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2592
2593 do l = is3_weno%beg, is3_weno%end
2594 do k = is2_weno%beg, is2_weno%end
2595 do j = is1_weno%beg, is1_weno%end
2596 do i = 1, v_size
2597 ! reconstruct from left side
2598
2599 alpha(:) = 0._wp
2600 omega(:) = 0._wp
2601 beta(:) = weno_eps
2602
2603 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
2604 - v_rs_ws_x(j, k, l, i)
2605 dvd(-1) = v_rs_ws_x(j, k, l, i) &
2606 - v_rs_ws_x(j - 1, k, l, i)
2607
2608 poly(0) = v_rs_ws_x(j, k, l, i) &
2609 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
2610 poly(1) = v_rs_ws_x(j, k, l, i) &
2611 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
2612
2613 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) &
2614 + weno_eps
2615 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) &
2616 + weno_eps
2617
2618 if (wenojs) then
2619 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2620
2621 elseif (mapped_weno) then
2622 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2623 omega = alpha/sum(alpha)
2624 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) &
2625 *(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))))
2626
2627 elseif (wenoz) then
2628 ! Borges, et al. (2008)
2629
2630 tau = abs(beta(1) - beta(0))
2631 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2632
2633 end if
2634
2635 omega = alpha/sum(alpha)
2636
2637 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2638
2639 ! reconstruct from right side
2640
2641 poly(0) = v_rs_ws_x(j, k, l, i) &
2642 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
2643 poly(1) = v_rs_ws_x(j, k, l, i) &
2644 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
2645
2646 if (wenojs) then
2647 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2648
2649 elseif (mapped_weno) then
2650 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2651 omega = alpha/sum(alpha)
2652 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) &
2653 *(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))))
2654
2655 elseif (wenoz) then
2656
2657 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2658
2659 end if
2660
2661 omega = alpha/sum(alpha)
2662
2663 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2664
2665 end do
2666 end do
2667 end do
2668 end do
2669
2670# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2671
2672# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2673#if defined(MFC_OpenACC)
2674# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2675!$acc end parallel loop
2676# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2677#elif defined(MFC_OpenMP)
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
2682# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2683!$omp end target teams loop
2684# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2685#endif
2686# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2687
2688 end if
2689# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2690 if (weno_dir == 2) then
2691
2692# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2693
2694# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2695#if defined(MFC_OpenACC)
2696# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2697!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2698# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2699#elif defined(MFC_OpenMP)
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
2706# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2707!$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)
2708# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2709#endif
2710# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2711
2712 do l = is3_weno%beg, is3_weno%end
2713 do k = is2_weno%beg, is2_weno%end
2714 do j = is1_weno%beg, is1_weno%end
2715 do i = 1, v_size
2716 ! reconstruct from left side
2717
2718 alpha(:) = 0._wp
2719 omega(:) = 0._wp
2720 beta(:) = weno_eps
2721
2722 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
2723 - v_rs_ws_y(j, k, l, i)
2724 dvd(-1) = v_rs_ws_y(j, k, l, i) &
2725 - v_rs_ws_y(j - 1, k, l, i)
2726
2727 poly(0) = v_rs_ws_y(j, k, l, i) &
2728 + poly_coef_cbl_y(j, 0, 0)*dvd(0)
2729 poly(1) = v_rs_ws_y(j, k, l, i) &
2730 + poly_coef_cbl_y(j, 1, 0)*dvd(-1)
2731
2732 beta(0) = beta_coef_y(j, 0, 0)*dvd(0)*dvd(0) &
2733 + weno_eps
2734 beta(1) = beta_coef_y(j, 1, 0)*dvd(-1)*dvd(-1) &
2735 + weno_eps
2736
2737 if (wenojs) then
2738 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2739
2740 elseif (mapped_weno) then
2741 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2742 omega = alpha/sum(alpha)
2743 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) &
2744 *(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))))
2745
2746 elseif (wenoz) then
2747 ! Borges, et al. (2008)
2748
2749 tau = abs(beta(1) - beta(0))
2750 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2751
2752 end if
2753
2754 omega = alpha/sum(alpha)
2755
2756 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2757
2758 ! reconstruct from right side
2759
2760 poly(0) = v_rs_ws_y(j, k, l, i) &
2761 + poly_coef_cbr_y(j, 0, 0)*dvd(0)
2762 poly(1) = v_rs_ws_y(j, k, l, i) &
2763 + poly_coef_cbr_y(j, 1, 0)*dvd(-1)
2764
2765 if (wenojs) then
2766 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2767
2768 elseif (mapped_weno) then
2769 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2770 omega = alpha/sum(alpha)
2771 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) &
2772 *(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))))
2773
2774 elseif (wenoz) then
2775
2776 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2777
2778 end if
2779
2780 omega = alpha/sum(alpha)
2781
2782 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2783
2784 end do
2785 end do
2786 end do
2787 end do
2788
2789# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2790
2791# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2792#if defined(MFC_OpenACC)
2793# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2794!$acc end parallel loop
2795# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2796#elif defined(MFC_OpenMP)
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
2801# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2802!$omp end target teams loop
2803# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2804#endif
2805# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2806
2807 end if
2808# 714 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2809 if (weno_dir == 3) then
2810
2811# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2812
2813# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2814#if defined(MFC_OpenACC)
2815# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2816!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
2817# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2818#elif defined(MFC_OpenMP)
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
2825# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2826!$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)
2827# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2828#endif
2829# 715 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2830
2831 do l = is3_weno%beg, is3_weno%end
2832 do k = is2_weno%beg, is2_weno%end
2833 do j = is1_weno%beg, is1_weno%end
2834 do i = 1, v_size
2835 ! reconstruct from left side
2836
2837 alpha(:) = 0._wp
2838 omega(:) = 0._wp
2839 beta(:) = weno_eps
2840
2841 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
2842 - v_rs_ws_z(j, k, l, i)
2843 dvd(-1) = v_rs_ws_z(j, k, l, i) &
2844 - v_rs_ws_z(j - 1, k, l, i)
2845
2846 poly(0) = v_rs_ws_z(j, k, l, i) &
2847 + poly_coef_cbl_z(j, 0, 0)*dvd(0)
2848 poly(1) = v_rs_ws_z(j, k, l, i) &
2849 + poly_coef_cbl_z(j, 1, 0)*dvd(-1)
2850
2851 beta(0) = beta_coef_z(j, 0, 0)*dvd(0)*dvd(0) &
2852 + weno_eps
2853 beta(1) = beta_coef_z(j, 1, 0)*dvd(-1)*dvd(-1) &
2854 + weno_eps
2855
2856 if (wenojs) then
2857 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2858
2859 elseif (mapped_weno) then
2860 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2861 omega = alpha/sum(alpha)
2862 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) &
2863 *(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))))
2864
2865 elseif (wenoz) then
2866 ! Borges, et al. (2008)
2867
2868 tau = abs(beta(1) - beta(0))
2869 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2870
2871 end if
2872
2873 omega = alpha/sum(alpha)
2874
2875 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2876
2877 ! reconstruct from right side
2878
2879 poly(0) = v_rs_ws_z(j, k, l, i) &
2880 + poly_coef_cbr_z(j, 0, 0)*dvd(0)
2881 poly(1) = v_rs_ws_z(j, k, l, i) &
2882 + poly_coef_cbr_z(j, 1, 0)*dvd(-1)
2883
2884 if (wenojs) then
2885 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2886
2887 elseif (mapped_weno) then
2888 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
2889 omega = alpha/sum(alpha)
2890 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) &
2891 *(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))))
2892
2893 elseif (wenoz) then
2894
2895 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)*(1._wp + tau/beta(0:weno_num_stencils))
2896
2897 end if
2898
2899 omega = alpha/sum(alpha)
2900
2901 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
2902
2903 end do
2904 end do
2905 end do
2906 end do
2907
2908# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2909
2910# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2911#if defined(MFC_OpenACC)
2912# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2913!$acc end parallel loop
2914# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2915#elif defined(MFC_OpenMP)
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
2920# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2921!$omp end target teams loop
2922# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2923#endif
2924# 792 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2925
2926 end if
2927# 795 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2928 end if
2929 if (weno_order == 5 .or. dummy) then
2930# 798 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2931# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2932 if (weno_dir == 1) then
2933
2934# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2935
2936# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2937#if defined(MFC_OpenACC)
2938# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2939!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
2940# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2941#elif defined(MFC_OpenMP)
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
2948# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2949!$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)
2950# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2951#endif
2952# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2953
2954 do l = is3_weno%beg, is3_weno%end
2955 do k = is2_weno%beg, is2_weno%end
2956 do j = is1_weno%beg, is1_weno%end
2957
2958# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2959#if defined(MFC_OpenACC)
2960# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2961!$acc loop seq
2962# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2963#elif defined(MFC_OpenMP)
2964# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2965
2966# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2967#endif
2968 do i = 1, v_size
2969 ! reconstruct from left side
2970
2971 alpha(:) = 0._wp
2972 omega(:) = 0._wp
2973 delta(:) = 0._wp
2974 beta(:) = weno_eps
2975
2976 dvd(1) = v_rs_ws_x(j + 2, k, l, i) &
2977 - v_rs_ws_x(j + 1, k, l, i)
2978 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
2979 - v_rs_ws_x(j, k, l, i)
2980 dvd(-1) = v_rs_ws_x(j, k, l, i) &
2981 - v_rs_ws_x(j - 1, k, l, i)
2982 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) &
2983 - v_rs_ws_x(j - 2, k, l, i)
2984
2985 poly(0) = v_rs_ws_x(j, k, l, i) &
2986 + poly_coef_cbl_x(j, 0, 0)*dvd(1) &
2987 + poly_coef_cbl_x(j, 0, 1)*dvd(0)
2988 poly(1) = v_rs_ws_x(j, k, l, i) &
2989 + poly_coef_cbl_x(j, 1, 0)*dvd(0) &
2990 + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
2991 poly(2) = v_rs_ws_x(j, k, l, i) &
2992 + poly_coef_cbl_x(j, 2, 0)*dvd(-1) &
2993 + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
2994
2995 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) &
2996 + beta_coef_x(j, 0, 1)*dvd(1)*dvd(0) &
2997 + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) &
2998 + weno_eps
2999 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) &
3000 + beta_coef_x(j, 1, 1)*dvd(0)*dvd(-1) &
3001 + beta_coef_x(j, 1, 2)*dvd(-1)*dvd(-1) &
3002 + weno_eps
3003 beta(2) = beta_coef_x(j, 2, 0)*dvd(-1)*dvd(-1) &
3004 + beta_coef_x(j, 2, 1)*dvd(-1)*dvd(-2) &
3005 + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) &
3006 + weno_eps
3007
3008 if (wenojs) then
3009 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3010
3011 elseif (mapped_weno) then
3012 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3013 omega = alpha/sum(alpha)
3014 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) &
3015 *(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))))
3016
3017 elseif (wenoz) then
3018
3019 ! Borges, et al. (2008)
3020
3021 tau = abs(beta(2) - beta(0)) ! Equation 25
3022
3023# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3024#if defined(MFC_OpenACC)
3025# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3026!$acc loop seq
3027# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3028#elif defined(MFC_OpenMP)
3029# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3030
3031# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3032#endif
3033 do q = 0, weno_num_stencils
3034 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3035 end do
3036
3037 elseif (teno) then
3038 ! Fu, et al. (2016)
3039 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3040 tau = abs(beta(2) - beta(0))
3041
3042# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3043#if defined(MFC_OpenACC)
3044# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3045!$acc loop seq
3046# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3047#elif defined(MFC_OpenMP)
3048# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3049
3050# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3051#endif
3052 do q = 0, weno_num_stencils
3053 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3054 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3055 end do
3056 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3057
3058
3059# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3060#if defined(MFC_OpenACC)
3061# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3062!$acc loop seq
3063# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3064#elif defined(MFC_OpenMP)
3065# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3066
3067# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3068#endif
3069 do q = 0, weno_num_stencils
3070 if (omega(q) < teno_ct) then ! Equation 26
3071 delta(q) = 0._wp
3072 else
3073 delta(q) = 1._wp
3074 end if
3075 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3076 end do
3077 end if
3078
3079 omega = alpha/sum(alpha)
3080
3081 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3082
3083 ! reconstruct from right side
3084
3085 poly(0) = v_rs_ws_x(j, k, l, i) &
3086 + poly_coef_cbr_x(j, 0, 0)*dvd(1) &
3087 + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3088 poly(1) = v_rs_ws_x(j, k, l, i) &
3089 + poly_coef_cbr_x(j, 1, 0)*dvd(0) &
3090 + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3091 poly(2) = v_rs_ws_x(j, k, l, i) &
3092 + poly_coef_cbr_x(j, 2, 0)*dvd(-1) &
3093 + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3094
3095 if (wenojs) then
3096 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3097
3098 elseif (mapped_weno) then
3099 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3100 omega = alpha/sum(alpha)
3101 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) &
3102 *(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))))
3103
3104 elseif (wenoz) then
3105
3106
3107# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3108#if defined(MFC_OpenACC)
3109# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3110!$acc loop seq
3111# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3112#elif defined(MFC_OpenMP)
3113# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3114
3115# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3116#endif
3117 do q = 0, weno_num_stencils
3118 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3119 end do
3120
3121 elseif (teno) then
3122
3123# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3124#if defined(MFC_OpenACC)
3125# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3126!$acc loop seq
3127# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3128#elif defined(MFC_OpenMP)
3129# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3130
3131# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3132#endif
3133 do q = 0, weno_num_stencils
3134 alpha(q) = delta(q)*d_cbr_x(q, j)
3135 end do
3136 end if
3137
3138 omega = alpha/sum(alpha)
3139
3140 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3141
3142 end do
3143 end do
3144 end do
3145 end do
3146
3147# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3148
3149# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3150#if defined(MFC_OpenACC)
3151# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3152!$acc end parallel loop
3153# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3154#elif defined(MFC_OpenMP)
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
3159# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3160!$omp end target teams loop
3161# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3162#endif
3163# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3164
3165
3166 if (mp_weno) then
3167 call s_preserve_monotonicity(v_rs_ws_x, vl_rs_vf_x, &
3168 vr_rs_vf_x)
3169 end if
3170 end if
3171# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3172 if (weno_dir == 2) then
3173
3174# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175
3176# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177#if defined(MFC_OpenACC)
3178# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3180# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3181#elif defined(MFC_OpenMP)
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
3188# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3189!$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)
3190# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3191#endif
3192# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3193
3194 do l = is3_weno%beg, is3_weno%end
3195 do k = is2_weno%beg, is2_weno%end
3196 do j = is1_weno%beg, is1_weno%end
3197
3198# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199#if defined(MFC_OpenACC)
3200# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201!$acc loop seq
3202# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203#elif defined(MFC_OpenMP)
3204# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205
3206# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207#endif
3208 do i = 1, v_size
3209 ! reconstruct from left side
3210
3211 alpha(:) = 0._wp
3212 omega(:) = 0._wp
3213 delta(:) = 0._wp
3214 beta(:) = weno_eps
3215
3216 dvd(1) = v_rs_ws_y(j + 2, k, l, i) &
3217 - v_rs_ws_y(j + 1, k, l, i)
3218 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
3219 - v_rs_ws_y(j, k, l, i)
3220 dvd(-1) = v_rs_ws_y(j, k, l, i) &
3221 - v_rs_ws_y(j - 1, k, l, i)
3222 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) &
3223 - v_rs_ws_y(j - 2, k, l, i)
3224
3225 poly(0) = v_rs_ws_y(j, k, l, i) &
3226 + poly_coef_cbl_y(j, 0, 0)*dvd(1) &
3227 + poly_coef_cbl_y(j, 0, 1)*dvd(0)
3228 poly(1) = v_rs_ws_y(j, k, l, i) &
3229 + poly_coef_cbl_y(j, 1, 0)*dvd(0) &
3230 + poly_coef_cbl_y(j, 1, 1)*dvd(-1)
3231 poly(2) = v_rs_ws_y(j, k, l, i) &
3232 + poly_coef_cbl_y(j, 2, 0)*dvd(-1) &
3233 + poly_coef_cbl_y(j, 2, 1)*dvd(-2)
3234
3235 beta(0) = beta_coef_y(j, 0, 0)*dvd(1)*dvd(1) &
3236 + beta_coef_y(j, 0, 1)*dvd(1)*dvd(0) &
3237 + beta_coef_y(j, 0, 2)*dvd(0)*dvd(0) &
3238 + weno_eps
3239 beta(1) = beta_coef_y(j, 1, 0)*dvd(0)*dvd(0) &
3240 + beta_coef_y(j, 1, 1)*dvd(0)*dvd(-1) &
3241 + beta_coef_y(j, 1, 2)*dvd(-1)*dvd(-1) &
3242 + weno_eps
3243 beta(2) = beta_coef_y(j, 2, 0)*dvd(-1)*dvd(-1) &
3244 + beta_coef_y(j, 2, 1)*dvd(-1)*dvd(-2) &
3245 + beta_coef_y(j, 2, 2)*dvd(-2)*dvd(-2) &
3246 + weno_eps
3247
3248 if (wenojs) then
3249 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3250
3251 elseif (mapped_weno) then
3252 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3253 omega = alpha/sum(alpha)
3254 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) &
3255 *(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))))
3256
3257 elseif (wenoz) then
3258
3259 ! Borges, et al. (2008)
3260
3261 tau = abs(beta(2) - beta(0)) ! Equation 25
3262
3263# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3264#if defined(MFC_OpenACC)
3265# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3266!$acc loop seq
3267# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3268#elif defined(MFC_OpenMP)
3269# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3270
3271# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3272#endif
3273 do q = 0, weno_num_stencils
3274 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3275 end do
3276
3277 elseif (teno) then
3278 ! Fu, et al. (2016)
3279 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3280 tau = abs(beta(2) - beta(0))
3281
3282# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3283#if defined(MFC_OpenACC)
3284# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285!$acc loop seq
3286# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3287#elif defined(MFC_OpenMP)
3288# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3289
3290# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3291#endif
3292 do q = 0, weno_num_stencils
3293 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3294 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3295 end do
3296 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3297
3298
3299# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3300#if defined(MFC_OpenACC)
3301# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3302!$acc loop seq
3303# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3304#elif defined(MFC_OpenMP)
3305# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3306
3307# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3308#endif
3309 do q = 0, weno_num_stencils
3310 if (omega(q) < teno_ct) then ! Equation 26
3311 delta(q) = 0._wp
3312 else
3313 delta(q) = 1._wp
3314 end if
3315 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
3316 end do
3317 end if
3318
3319 omega = alpha/sum(alpha)
3320
3321 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3322
3323 ! reconstruct from right side
3324
3325 poly(0) = v_rs_ws_y(j, k, l, i) &
3326 + poly_coef_cbr_y(j, 0, 0)*dvd(1) &
3327 + poly_coef_cbr_y(j, 0, 1)*dvd(0)
3328 poly(1) = v_rs_ws_y(j, k, l, i) &
3329 + poly_coef_cbr_y(j, 1, 0)*dvd(0) &
3330 + poly_coef_cbr_y(j, 1, 1)*dvd(-1)
3331 poly(2) = v_rs_ws_y(j, k, l, i) &
3332 + poly_coef_cbr_y(j, 2, 0)*dvd(-1) &
3333 + poly_coef_cbr_y(j, 2, 1)*dvd(-2)
3334
3335 if (wenojs) then
3336 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3337
3338 elseif (mapped_weno) then
3339 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3340 omega = alpha/sum(alpha)
3341 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) &
3342 *(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))))
3343
3344 elseif (wenoz) then
3345
3346
3347# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3348#if defined(MFC_OpenACC)
3349# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3350!$acc loop seq
3351# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3352#elif defined(MFC_OpenMP)
3353# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3354
3355# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3356#endif
3357 do q = 0, weno_num_stencils
3358 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q)))
3359 end do
3360
3361 elseif (teno) then
3362
3363# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3364#if defined(MFC_OpenACC)
3365# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3366!$acc loop seq
3367# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3368#elif defined(MFC_OpenMP)
3369# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3370
3371# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3372#endif
3373 do q = 0, weno_num_stencils
3374 alpha(q) = delta(q)*d_cbr_y(q, j)
3375 end do
3376 end if
3377
3378 omega = alpha/sum(alpha)
3379
3380 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3381
3382 end do
3383 end do
3384 end do
3385 end do
3386
3387# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3388
3389# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3390#if defined(MFC_OpenACC)
3391# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3392!$acc end parallel loop
3393# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3394#elif defined(MFC_OpenMP)
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
3399# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3400!$omp end target teams loop
3401# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3402#endif
3403# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3404
3405
3406 if (mp_weno) then
3407 call s_preserve_monotonicity(v_rs_ws_y, vl_rs_vf_y, &
3408 vr_rs_vf_y)
3409 end if
3410 end if
3411# 799 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3412 if (weno_dir == 3) then
3413
3414# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3415
3416# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3417#if defined(MFC_OpenACC)
3418# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3419!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3420# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3421#elif defined(MFC_OpenMP)
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
3428# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429!$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)
3430# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3431#endif
3432# 800 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3433
3434 do l = is3_weno%beg, is3_weno%end
3435 do k = is2_weno%beg, is2_weno%end
3436 do j = is1_weno%beg, is1_weno%end
3437
3438# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3439#if defined(MFC_OpenACC)
3440# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3441!$acc loop seq
3442# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3443#elif defined(MFC_OpenMP)
3444# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3445
3446# 804 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3447#endif
3448 do i = 1, v_size
3449 ! reconstruct from left side
3450
3451 alpha(:) = 0._wp
3452 omega(:) = 0._wp
3453 delta(:) = 0._wp
3454 beta(:) = weno_eps
3455
3456 dvd(1) = v_rs_ws_z(j + 2, k, l, i) &
3457 - v_rs_ws_z(j + 1, k, l, i)
3458 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
3459 - v_rs_ws_z(j, k, l, i)
3460 dvd(-1) = v_rs_ws_z(j, k, l, i) &
3461 - v_rs_ws_z(j - 1, k, l, i)
3462 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) &
3463 - v_rs_ws_z(j - 2, k, l, i)
3464
3465 poly(0) = v_rs_ws_z(j, k, l, i) &
3466 + poly_coef_cbl_z(j, 0, 0)*dvd(1) &
3467 + poly_coef_cbl_z(j, 0, 1)*dvd(0)
3468 poly(1) = v_rs_ws_z(j, k, l, i) &
3469 + poly_coef_cbl_z(j, 1, 0)*dvd(0) &
3470 + poly_coef_cbl_z(j, 1, 1)*dvd(-1)
3471 poly(2) = v_rs_ws_z(j, k, l, i) &
3472 + poly_coef_cbl_z(j, 2, 0)*dvd(-1) &
3473 + poly_coef_cbl_z(j, 2, 1)*dvd(-2)
3474
3475 beta(0) = beta_coef_z(j, 0, 0)*dvd(1)*dvd(1) &
3476 + beta_coef_z(j, 0, 1)*dvd(1)*dvd(0) &
3477 + beta_coef_z(j, 0, 2)*dvd(0)*dvd(0) &
3478 + weno_eps
3479 beta(1) = beta_coef_z(j, 1, 0)*dvd(0)*dvd(0) &
3480 + beta_coef_z(j, 1, 1)*dvd(0)*dvd(-1) &
3481 + beta_coef_z(j, 1, 2)*dvd(-1)*dvd(-1) &
3482 + weno_eps
3483 beta(2) = beta_coef_z(j, 2, 0)*dvd(-1)*dvd(-1) &
3484 + beta_coef_z(j, 2, 1)*dvd(-1)*dvd(-2) &
3485 + beta_coef_z(j, 2, 2)*dvd(-2)*dvd(-2) &
3486 + weno_eps
3487
3488 if (wenojs) then
3489 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3490
3491 elseif (mapped_weno) then
3492 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3493 omega = alpha/sum(alpha)
3494 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) &
3495 *(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))))
3496
3497 elseif (wenoz) then
3498
3499 ! Borges, et al. (2008)
3500
3501 tau = abs(beta(2) - beta(0)) ! Equation 25
3502
3503# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3504#if defined(MFC_OpenACC)
3505# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3506!$acc loop seq
3507# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3508#elif defined(MFC_OpenMP)
3509# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3510
3511# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3512#endif
3513 do q = 0, weno_num_stencils
3514 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q))) ! Equation 28 (note: weno_eps was already added to beta)
3515 end do
3516
3517 elseif (teno) then
3518 ! Fu, et al. (2016)
3519 ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3520 tau = abs(beta(2) - beta(0))
3521
3522# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3523#if defined(MFC_OpenACC)
3524# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3525!$acc loop seq
3526# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3527#elif defined(MFC_OpenMP)
3528# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3529
3530# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3531#endif
3532 do q = 0, weno_num_stencils
3533 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3534 alpha(q) = (alpha(q)**3._wp)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3535 end do
3536 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3537
3538
3539# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540#if defined(MFC_OpenACC)
3541# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3542!$acc loop seq
3543# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3544#elif defined(MFC_OpenMP)
3545# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546
3547# 875 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3548#endif
3549 do q = 0, weno_num_stencils
3550 if (omega(q) < teno_ct) then ! Equation 26
3551 delta(q) = 0._wp
3552 else
3553 delta(q) = 1._wp
3554 end if
3555 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
3556 end do
3557 end if
3558
3559 omega = alpha/sum(alpha)
3560
3561 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3562
3563 ! reconstruct from right side
3564
3565 poly(0) = v_rs_ws_z(j, k, l, i) &
3566 + poly_coef_cbr_z(j, 0, 0)*dvd(1) &
3567 + poly_coef_cbr_z(j, 0, 1)*dvd(0)
3568 poly(1) = v_rs_ws_z(j, k, l, i) &
3569 + poly_coef_cbr_z(j, 1, 0)*dvd(0) &
3570 + poly_coef_cbr_z(j, 1, 1)*dvd(-1)
3571 poly(2) = v_rs_ws_z(j, k, l, i) &
3572 + poly_coef_cbr_z(j, 2, 0)*dvd(-1) &
3573 + poly_coef_cbr_z(j, 2, 1)*dvd(-2)
3574
3575 if (wenojs) then
3576 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3577
3578 elseif (mapped_weno) then
3579 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3580 omega = alpha/sum(alpha)
3581 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) &
3582 *(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))))
3583
3584 elseif (wenoz) then
3585
3586
3587# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3588#if defined(MFC_OpenACC)
3589# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3590!$acc loop seq
3591# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3592#elif defined(MFC_OpenMP)
3593# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3594
3595# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3596#endif
3597 do q = 0, weno_num_stencils
3598 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q)))
3599 end do
3600
3601 elseif (teno) then
3602
3603# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3604#if defined(MFC_OpenACC)
3605# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3606!$acc loop seq
3607# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3608#elif defined(MFC_OpenMP)
3609# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3610
3611# 919 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3612#endif
3613 do q = 0, weno_num_stencils
3614 alpha(q) = delta(q)*d_cbr_z(q, j)
3615 end do
3616 end if
3617
3618 omega = alpha/sum(alpha)
3619
3620 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3621
3622 end do
3623 end do
3624 end do
3625 end do
3626
3627# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3628
3629# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3630#if defined(MFC_OpenACC)
3631# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3632!$acc end parallel loop
3633# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3634#elif defined(MFC_OpenMP)
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
3639# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3640!$omp end target teams loop
3641# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3642#endif
3643# 933 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3644
3645
3646 if (mp_weno) then
3647 call s_preserve_monotonicity(v_rs_ws_z, vl_rs_vf_z, &
3648 vr_rs_vf_z)
3649 end if
3650 end if
3651# 941 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3652# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3653 end if
3654 if (weno_order == 7 .or. dummy) then
3655# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3656# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3657 if (weno_dir == 1) then
3658
3659# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3660
3661# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3662#if defined(MFC_OpenACC)
3663# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3664!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3665# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3666#elif defined(MFC_OpenMP)
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
3673# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3674!$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)
3675# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676#endif
3677# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3678
3679 do l = is3_weno%beg, is3_weno%end
3680 do k = is2_weno%beg, is2_weno%end
3681 do j = is1_weno%beg, is1_weno%end
3682
3683# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3684#if defined(MFC_OpenACC)
3685# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3686!$acc loop seq
3687# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3688#elif defined(MFC_OpenMP)
3689# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3690
3691# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3692#endif
3693 do i = 1, v_size
3694
3695 alpha(:) = 0._wp
3696 omega(:) = 0._wp
3697 delta(:) = 0._wp
3698 beta(:) = weno_eps
3699
3700 if (teno) v = v_rs_ws_x(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
3701
3702 if (.not. teno) then
3703 dvd(2) = v_rs_ws_x(j + 3, k, l, i) &
3704 - v_rs_ws_x(j + 2, k, l, i)
3705 dvd(1) = v_rs_ws_x(j + 2, k, l, i) &
3706 - v_rs_ws_x(j + 1, k, l, i)
3707 dvd(0) = v_rs_ws_x(j + 1, k, l, i) &
3708 - v_rs_ws_x(j, k, l, i)
3709 dvd(-1) = v_rs_ws_x(j, k, l, i) &
3710 - v_rs_ws_x(j - 1, k, l, i)
3711 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) &
3712 - v_rs_ws_x(j - 2, k, l, i)
3713 dvd(-3) = v_rs_ws_x(j - 2, k, l, i) &
3714 - v_rs_ws_x(j - 3, k, l, i)
3715
3716 poly(3) = v_rs_ws_x(j, k, l, i) &
3717 + poly_coef_cbl_x(j, 0, 0)*dvd(2) &
3718 + poly_coef_cbl_x(j, 0, 1)*dvd(1) &
3719 + poly_coef_cbl_x(j, 0, 2)*dvd(0)
3720 poly(2) = v_rs_ws_x(j, k, l, i) &
3721 + poly_coef_cbl_x(j, 1, 0)*dvd(1) &
3722 + poly_coef_cbl_x(j, 1, 1)*dvd(0) &
3723 + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
3724 poly(1) = v_rs_ws_x(j, k, l, i) &
3725 + poly_coef_cbl_x(j, 2, 0)*dvd(0) &
3726 + poly_coef_cbl_x(j, 2, 1)*dvd(-1) &
3727 + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
3728 poly(0) = v_rs_ws_x(j, k, l, i) &
3729 + poly_coef_cbl_x(j, 3, 0)*dvd(-1) &
3730 + poly_coef_cbl_x(j, 3, 1)*dvd(-2) &
3731 + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
3732
3733 else
3734# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3735 ! (Fu, et al., 2016) Table 1
3736 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
3737 ! See Figure 2 (right) for right-sided flux (at i+1/2)
3738 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
3739 ! But we need to keep the stencil order to reuse the beta coefficients
3740 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
3741 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
3742 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
3743 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
3744 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
3745# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3746 end if
3747
3748 if (.not. teno) then
3749
3750 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) &
3751 + beta_coef_x(j, 0, 1)*dvd(2)*dvd(1) &
3752 + beta_coef_x(j, 0, 2)*dvd(2)*dvd(0) &
3753 + beta_coef_x(j, 0, 3)*dvd(1)*dvd(1) &
3754 + beta_coef_x(j, 0, 4)*dvd(1)*dvd(0) &
3755 + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) &
3756 + weno_eps
3757
3758 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) &
3759 + beta_coef_x(j, 1, 1)*dvd(1)*dvd(0) &
3760 + beta_coef_x(j, 1, 2)*dvd(1)*dvd(-1) &
3761 + beta_coef_x(j, 1, 3)*dvd(0)*dvd(0) &
3762 + beta_coef_x(j, 1, 4)*dvd(0)*dvd(-1) &
3763 + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) &
3764 + weno_eps
3765
3766 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) &
3767 + beta_coef_x(j, 2, 1)*dvd(0)*dvd(-1) &
3768 + beta_coef_x(j, 2, 2)*dvd(0)*dvd(-2) &
3769 + beta_coef_x(j, 2, 3)*dvd(-1)*dvd(-1) &
3770 + beta_coef_x(j, 2, 4)*dvd(-1)*dvd(-2) &
3771 + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) &
3772 + weno_eps
3773
3774 beta(0) = beta_coef_x(j, 3, 0)*dvd(-1)*dvd(-1) &
3775 + beta_coef_x(j, 3, 1)*dvd(-1)*dvd(-2) &
3776 + beta_coef_x(j, 3, 2)*dvd(-1)*dvd(-3) &
3777 + beta_coef_x(j, 3, 3)*dvd(-2)*dvd(-2) &
3778 + beta_coef_x(j, 3, 4)*dvd(-2)*dvd(-3) &
3779 + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) &
3780 + weno_eps
3781
3782 else ! TENO
3783# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3784 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
3785 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 !&
3786 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 !&
3787 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 !&
3788
3789 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
3790 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
3791 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
3792 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
3793 + weno_eps !&
3794
3795 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
3796 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
3797 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
3798 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
3799 + weno_eps !&
3800# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3801 end if
3802
3803 if (wenojs) then
3804 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3805
3806 elseif (mapped_weno) then
3807 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3808 omega = alpha/sum(alpha)
3809 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) &
3810 *(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))))
3811
3812 elseif (wenoz) then
3813 ! Castro, et al. (2010)
3814 ! Don & Borges (2013) also helps
3815 tau = abs(beta(3) - beta(0)) ! Equation 50
3816
3817# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3818#if defined(MFC_OpenACC)
3819# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3820!$acc loop seq
3821# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3822#elif defined(MFC_OpenMP)
3823# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3824
3825# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3826#endif
3827 do q = 0, weno_num_stencils
3828 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
3829 end do
3830
3831 elseif (teno) then
3832# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3833 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
3834 alpha = 1._wp + tau/beta
3835 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
3836 omega = alpha/sum(alpha)
3837
3838
3839# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3840#if defined(MFC_OpenACC)
3841# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3842!$acc loop seq
3843# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3844#elif defined(MFC_OpenMP)
3845# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3846
3847# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3848#endif
3849 do q = 0, weno_num_stencils
3850 if (omega(q) < teno_ct) then ! Equation 26
3851 delta(q) = 0._wp
3852 else
3853 delta(q) = 1._wp
3854 end if
3855 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3856 end do
3857# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3858 end if
3859
3860 omega = alpha/sum(alpha)
3861
3862 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
3863
3864 if (teno) then
3865# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3866 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
3867# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3868 end if
3869
3870 if (.not. teno) then
3871 poly(3) = v_rs_ws_x(j, k, l, i) &
3872 + poly_coef_cbr_x(j, 0, 0)*dvd(2) &
3873 + poly_coef_cbr_x(j, 0, 1)*dvd(1) &
3874 + poly_coef_cbr_x(j, 0, 2)*dvd(0)
3875 poly(2) = v_rs_ws_x(j, k, l, i) &
3876 + poly_coef_cbr_x(j, 1, 0)*dvd(1) &
3877 + poly_coef_cbr_x(j, 1, 1)*dvd(0) &
3878 + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
3879 poly(1) = v_rs_ws_x(j, k, l, i) &
3880 + poly_coef_cbr_x(j, 2, 0)*dvd(0) &
3881 + poly_coef_cbr_x(j, 2, 1)*dvd(-1) &
3882 + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
3883 poly(0) = v_rs_ws_x(j, k, l, i) &
3884 + poly_coef_cbr_x(j, 3, 0)*dvd(-1) &
3885 + poly_coef_cbr_x(j, 3, 1)*dvd(-2) &
3886 + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
3887 else
3888# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3889 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
3890 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
3891 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
3892 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
3893 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
3894# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3895 end if
3896
3897 if (wenojs) then
3898 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3899
3900 elseif (mapped_weno) then
3901 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
3902 omega = alpha/sum(alpha)
3903 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) &
3904 *(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))))
3905
3906 elseif (wenoz) then
3907
3908
3909# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3910#if defined(MFC_OpenACC)
3911# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3912!$acc loop seq
3913# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3914#elif defined(MFC_OpenMP)
3915# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916
3917# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3918#endif
3919 do q = 0, weno_num_stencils
3920 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
3921 end do
3922
3923 elseif (teno) then
3924
3925# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3926#if defined(MFC_OpenACC)
3927# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3928!$acc loop seq
3929# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3930#elif defined(MFC_OpenMP)
3931# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3932
3933# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3934#endif
3935 do q = 0, weno_num_stencils
3936 alpha(q) = delta(q)*d_cbr_x(q, j)
3937 end do
3938 end if
3939
3940 omega = alpha/sum(alpha)
3941
3942 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
3943
3944 if (teno) then
3945# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3946 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
3947# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3948 end if
3949
3950 end do
3951 end do
3952 end do
3953 end do
3954
3955# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3956
3957# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3958#if defined(MFC_OpenACC)
3959# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3960!$acc end parallel loop
3961# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3962#elif defined(MFC_OpenMP)
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
3967# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3968!$omp end target teams loop
3969# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3970#endif
3971# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3972
3973 end if
3974# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3975 if (weno_dir == 2) then
3976
3977# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3978
3979# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3980#if defined(MFC_OpenACC)
3981# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3982!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
3983# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3984#elif defined(MFC_OpenMP)
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
3991# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3992!$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)
3993# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3994#endif
3995# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3996
3997 do l = is3_weno%beg, is3_weno%end
3998 do k = is2_weno%beg, is2_weno%end
3999 do j = is1_weno%beg, is1_weno%end
4000
4001# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4002#if defined(MFC_OpenACC)
4003# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4004!$acc loop seq
4005# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4006#elif defined(MFC_OpenMP)
4007# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4008
4009# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4010#endif
4011 do i = 1, v_size
4012
4013 alpha(:) = 0._wp
4014 omega(:) = 0._wp
4015 delta(:) = 0._wp
4016 beta(:) = weno_eps
4017
4018 if (teno) v = v_rs_ws_y(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
4019
4020 if (.not. teno) then
4021 dvd(2) = v_rs_ws_y(j + 3, k, l, i) &
4022 - v_rs_ws_y(j + 2, k, l, i)
4023 dvd(1) = v_rs_ws_y(j + 2, k, l, i) &
4024 - v_rs_ws_y(j + 1, k, l, i)
4025 dvd(0) = v_rs_ws_y(j + 1, k, l, i) &
4026 - v_rs_ws_y(j, k, l, i)
4027 dvd(-1) = v_rs_ws_y(j, k, l, i) &
4028 - v_rs_ws_y(j - 1, k, l, i)
4029 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) &
4030 - v_rs_ws_y(j - 2, k, l, i)
4031 dvd(-3) = v_rs_ws_y(j - 2, k, l, i) &
4032 - v_rs_ws_y(j - 3, k, l, i)
4033
4034 poly(3) = v_rs_ws_y(j, k, l, i) &
4035 + poly_coef_cbl_y(j, 0, 0)*dvd(2) &
4036 + poly_coef_cbl_y(j, 0, 1)*dvd(1) &
4037 + poly_coef_cbl_y(j, 0, 2)*dvd(0)
4038 poly(2) = v_rs_ws_y(j, k, l, i) &
4039 + poly_coef_cbl_y(j, 1, 0)*dvd(1) &
4040 + poly_coef_cbl_y(j, 1, 1)*dvd(0) &
4041 + poly_coef_cbl_y(j, 1, 2)*dvd(-1)
4042 poly(1) = v_rs_ws_y(j, k, l, i) &
4043 + poly_coef_cbl_y(j, 2, 0)*dvd(0) &
4044 + poly_coef_cbl_y(j, 2, 1)*dvd(-1) &
4045 + poly_coef_cbl_y(j, 2, 2)*dvd(-2)
4046 poly(0) = v_rs_ws_y(j, k, l, i) &
4047 + poly_coef_cbl_y(j, 3, 0)*dvd(-1) &
4048 + poly_coef_cbl_y(j, 3, 1)*dvd(-2) &
4049 + poly_coef_cbl_y(j, 3, 2)*dvd(-3)
4050
4051 else
4052# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4053 ! (Fu, et al., 2016) Table 1
4054 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
4055 ! See Figure 2 (right) for right-sided flux (at i+1/2)
4056 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
4057 ! But we need to keep the stencil order to reuse the beta coefficients
4058 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
4059 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
4060 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
4061 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
4062 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
4063# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4064 end if
4065
4066 if (.not. teno) then
4067
4068 beta(3) = beta_coef_y(j, 0, 0)*dvd(2)*dvd(2) &
4069 + beta_coef_y(j, 0, 1)*dvd(2)*dvd(1) &
4070 + beta_coef_y(j, 0, 2)*dvd(2)*dvd(0) &
4071 + beta_coef_y(j, 0, 3)*dvd(1)*dvd(1) &
4072 + beta_coef_y(j, 0, 4)*dvd(1)*dvd(0) &
4073 + beta_coef_y(j, 0, 5)*dvd(0)*dvd(0) &
4074 + weno_eps
4075
4076 beta(2) = beta_coef_y(j, 1, 0)*dvd(1)*dvd(1) &
4077 + beta_coef_y(j, 1, 1)*dvd(1)*dvd(0) &
4078 + beta_coef_y(j, 1, 2)*dvd(1)*dvd(-1) &
4079 + beta_coef_y(j, 1, 3)*dvd(0)*dvd(0) &
4080 + beta_coef_y(j, 1, 4)*dvd(0)*dvd(-1) &
4081 + beta_coef_y(j, 1, 5)*dvd(-1)*dvd(-1) &
4082 + weno_eps
4083
4084 beta(1) = beta_coef_y(j, 2, 0)*dvd(0)*dvd(0) &
4085 + beta_coef_y(j, 2, 1)*dvd(0)*dvd(-1) &
4086 + beta_coef_y(j, 2, 2)*dvd(0)*dvd(-2) &
4087 + beta_coef_y(j, 2, 3)*dvd(-1)*dvd(-1) &
4088 + beta_coef_y(j, 2, 4)*dvd(-1)*dvd(-2) &
4089 + beta_coef_y(j, 2, 5)*dvd(-2)*dvd(-2) &
4090 + weno_eps
4091
4092 beta(0) = beta_coef_y(j, 3, 0)*dvd(-1)*dvd(-1) &
4093 + beta_coef_y(j, 3, 1)*dvd(-1)*dvd(-2) &
4094 + beta_coef_y(j, 3, 2)*dvd(-1)*dvd(-3) &
4095 + beta_coef_y(j, 3, 3)*dvd(-2)*dvd(-2) &
4096 + beta_coef_y(j, 3, 4)*dvd(-2)*dvd(-3) &
4097 + beta_coef_y(j, 3, 5)*dvd(-3)*dvd(-3) &
4098 + weno_eps
4099
4100 else ! TENO
4101# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4102 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
4103 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 !&
4104 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 !&
4105 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 !&
4106
4107 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
4108 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
4109 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
4110 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
4111 + weno_eps !&
4112
4113 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
4114 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
4115 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
4116 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
4117 + weno_eps !&
4118# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4119 end if
4120
4121 if (wenojs) then
4122 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4123
4124 elseif (mapped_weno) then
4125 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4126 omega = alpha/sum(alpha)
4127 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) &
4128 *(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))))
4129
4130 elseif (wenoz) then
4131 ! Castro, et al. (2010)
4132 ! Don & Borges (2013) also helps
4133 tau = abs(beta(3) - beta(0)) ! Equation 50
4134
4135# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4136#if defined(MFC_OpenACC)
4137# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4138!$acc loop seq
4139# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4140#elif defined(MFC_OpenMP)
4141# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4142
4143# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4144#endif
4145 do q = 0, weno_num_stencils
4146 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4147 end do
4148
4149 elseif (teno) then
4150# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4151 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4152 alpha = 1._wp + tau/beta
4153 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4154 omega = alpha/sum(alpha)
4155
4156
4157# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4158#if defined(MFC_OpenACC)
4159# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4160!$acc loop seq
4161# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4162#elif defined(MFC_OpenMP)
4163# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4164
4165# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4166#endif
4167 do q = 0, weno_num_stencils
4168 if (omega(q) < teno_ct) then ! Equation 26
4169 delta(q) = 0._wp
4170 else
4171 delta(q) = 1._wp
4172 end if
4173 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4174 end do
4175# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4176 end if
4177
4178 omega = alpha/sum(alpha)
4179
4180 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4181
4182 if (teno) then
4183# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4184 vl_rs_vf_y(j, k, l, i) = vl_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4185# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4186 end if
4187
4188 if (.not. teno) then
4189 poly(3) = v_rs_ws_y(j, k, l, i) &
4190 + poly_coef_cbr_y(j, 0, 0)*dvd(2) &
4191 + poly_coef_cbr_y(j, 0, 1)*dvd(1) &
4192 + poly_coef_cbr_y(j, 0, 2)*dvd(0)
4193 poly(2) = v_rs_ws_y(j, k, l, i) &
4194 + poly_coef_cbr_y(j, 1, 0)*dvd(1) &
4195 + poly_coef_cbr_y(j, 1, 1)*dvd(0) &
4196 + poly_coef_cbr_y(j, 1, 2)*dvd(-1)
4197 poly(1) = v_rs_ws_y(j, k, l, i) &
4198 + poly_coef_cbr_y(j, 2, 0)*dvd(0) &
4199 + poly_coef_cbr_y(j, 2, 1)*dvd(-1) &
4200 + poly_coef_cbr_y(j, 2, 2)*dvd(-2)
4201 poly(0) = v_rs_ws_y(j, k, l, i) &
4202 + poly_coef_cbr_y(j, 3, 0)*dvd(-1) &
4203 + poly_coef_cbr_y(j, 3, 1)*dvd(-2) &
4204 + poly_coef_cbr_y(j, 3, 2)*dvd(-3)
4205 else
4206# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4207 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
4208 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
4209 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
4210 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
4211 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
4212# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4213 end if
4214
4215 if (wenojs) then
4216 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4217
4218 elseif (mapped_weno) then
4219 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4220 omega = alpha/sum(alpha)
4221 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) &
4222 *(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))))
4223
4224 elseif (wenoz) then
4225
4226
4227# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4228#if defined(MFC_OpenACC)
4229# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4230!$acc loop seq
4231# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4232#elif defined(MFC_OpenMP)
4233# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4234
4235# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4236#endif
4237 do q = 0, weno_num_stencils
4238 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4239 end do
4240
4241 elseif (teno) then
4242
4243# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4244#if defined(MFC_OpenACC)
4245# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4246!$acc loop seq
4247# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4248#elif defined(MFC_OpenMP)
4249# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4250
4251# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4252#endif
4253 do q = 0, weno_num_stencils
4254 alpha(q) = delta(q)*d_cbr_y(q, j)
4255 end do
4256 end if
4257
4258 omega = alpha/sum(alpha)
4259
4260 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4261
4262 if (teno) then
4263# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4264 vr_rs_vf_y(j, k, l, i) = vr_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4265# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4266 end if
4267
4268 end do
4269 end do
4270 end do
4271 end do
4272
4273# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4274
4275# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4276#if defined(MFC_OpenACC)
4277# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4278!$acc end parallel loop
4279# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4280#elif defined(MFC_OpenMP)
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
4285# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4286!$omp end target teams loop
4287# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4288#endif
4289# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4290
4291 end if
4292# 946 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4293 if (weno_dir == 3) then
4294
4295# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4296
4297# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4298#if defined(MFC_OpenACC)
4299# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4300!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4301# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4302#elif defined(MFC_OpenMP)
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
4309# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4310!$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)
4311# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4312#endif
4313# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4314
4315 do l = is3_weno%beg, is3_weno%end
4316 do k = is2_weno%beg, is2_weno%end
4317 do j = is1_weno%beg, is1_weno%end
4318
4319# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4320#if defined(MFC_OpenACC)
4321# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4322!$acc loop seq
4323# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4324#elif defined(MFC_OpenMP)
4325# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4326
4327# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4328#endif
4329 do i = 1, v_size
4330
4331 alpha(:) = 0._wp
4332 omega(:) = 0._wp
4333 delta(:) = 0._wp
4334 beta(:) = weno_eps
4335
4336 if (teno) v = v_rs_ws_z(j - 3:j + 3, k, l, i) ! temporary field value array for clarity
4337
4338 if (.not. teno) then
4339 dvd(2) = v_rs_ws_z(j + 3, k, l, i) &
4340 - v_rs_ws_z(j + 2, k, l, i)
4341 dvd(1) = v_rs_ws_z(j + 2, k, l, i) &
4342 - v_rs_ws_z(j + 1, k, l, i)
4343 dvd(0) = v_rs_ws_z(j + 1, k, l, i) &
4344 - v_rs_ws_z(j, k, l, i)
4345 dvd(-1) = v_rs_ws_z(j, k, l, i) &
4346 - v_rs_ws_z(j - 1, k, l, i)
4347 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) &
4348 - v_rs_ws_z(j - 2, k, l, i)
4349 dvd(-3) = v_rs_ws_z(j - 2, k, l, i) &
4350 - v_rs_ws_z(j - 3, k, l, i)
4351
4352 poly(3) = v_rs_ws_z(j, k, l, i) &
4353 + poly_coef_cbl_z(j, 0, 0)*dvd(2) &
4354 + poly_coef_cbl_z(j, 0, 1)*dvd(1) &
4355 + poly_coef_cbl_z(j, 0, 2)*dvd(0)
4356 poly(2) = v_rs_ws_z(j, k, l, i) &
4357 + poly_coef_cbl_z(j, 1, 0)*dvd(1) &
4358 + poly_coef_cbl_z(j, 1, 1)*dvd(0) &
4359 + poly_coef_cbl_z(j, 1, 2)*dvd(-1)
4360 poly(1) = v_rs_ws_z(j, k, l, i) &
4361 + poly_coef_cbl_z(j, 2, 0)*dvd(0) &
4362 + poly_coef_cbl_z(j, 2, 1)*dvd(-1) &
4363 + poly_coef_cbl_z(j, 2, 2)*dvd(-2)
4364 poly(0) = v_rs_ws_z(j, k, l, i) &
4365 + poly_coef_cbl_z(j, 3, 0)*dvd(-1) &
4366 + poly_coef_cbl_z(j, 3, 1)*dvd(-2) &
4367 + poly_coef_cbl_z(j, 3, 2)*dvd(-3)
4368
4369 else
4370# 994 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4371 ! (Fu, et al., 2016) Table 1
4372 ! Note: Unlike TENO5, TENO7 stencils differ from WENO7 stencils
4373 ! See Figure 2 (right) for right-sided flux (at i+1/2)
4374 ! Here we need the left-sided flux, so we flip the weights with respect to the x=i point
4375 ! But we need to keep the stencil order to reuse the beta coefficients
4376 poly(0) = ( 2._wp*v(-1) + 5._wp*v( 0) - 1._wp*v( 1)) / 6._wp !&
4377 poly(1) = (11._wp*v( 0) - 7._wp*v( 1) + 2._wp*v( 2)) / 6._wp !&
4378 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v( 0)) / 6._wp !&
4379 poly(3) = (25._wp*v( 0) - 23._wp*v( 1) + 13._wp*v( 2) - 3._wp*v( 3)) / 12._wp !&
4380 poly(4) = ( 1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v( 0)) / 12._wp !&
4381# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4382 end if
4383
4384 if (.not. teno) then
4385
4386 beta(3) = beta_coef_z(j, 0, 0)*dvd(2)*dvd(2) &
4387 + beta_coef_z(j, 0, 1)*dvd(2)*dvd(1) &
4388 + beta_coef_z(j, 0, 2)*dvd(2)*dvd(0) &
4389 + beta_coef_z(j, 0, 3)*dvd(1)*dvd(1) &
4390 + beta_coef_z(j, 0, 4)*dvd(1)*dvd(0) &
4391 + beta_coef_z(j, 0, 5)*dvd(0)*dvd(0) &
4392 + weno_eps
4393
4394 beta(2) = beta_coef_z(j, 1, 0)*dvd(1)*dvd(1) &
4395 + beta_coef_z(j, 1, 1)*dvd(1)*dvd(0) &
4396 + beta_coef_z(j, 1, 2)*dvd(1)*dvd(-1) &
4397 + beta_coef_z(j, 1, 3)*dvd(0)*dvd(0) &
4398 + beta_coef_z(j, 1, 4)*dvd(0)*dvd(-1) &
4399 + beta_coef_z(j, 1, 5)*dvd(-1)*dvd(-1) &
4400 + weno_eps
4401
4402 beta(1) = beta_coef_z(j, 2, 0)*dvd(0)*dvd(0) &
4403 + beta_coef_z(j, 2, 1)*dvd(0)*dvd(-1) &
4404 + beta_coef_z(j, 2, 2)*dvd(0)*dvd(-2) &
4405 + beta_coef_z(j, 2, 3)*dvd(-1)*dvd(-1) &
4406 + beta_coef_z(j, 2, 4)*dvd(-1)*dvd(-2) &
4407 + beta_coef_z(j, 2, 5)*dvd(-2)*dvd(-2) &
4408 + weno_eps
4409
4410 beta(0) = beta_coef_z(j, 3, 0)*dvd(-1)*dvd(-1) &
4411 + beta_coef_z(j, 3, 1)*dvd(-1)*dvd(-2) &
4412 + beta_coef_z(j, 3, 2)*dvd(-1)*dvd(-3) &
4413 + beta_coef_z(j, 3, 3)*dvd(-2)*dvd(-2) &
4414 + beta_coef_z(j, 3, 4)*dvd(-2)*dvd(-3) &
4415 + beta_coef_z(j, 3, 5)*dvd(-3)*dvd(-3) &
4416 + weno_eps
4417
4418 else ! TENO
4419# 1043 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4420 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu & Tang, 2019) Section 3.2
4421 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 !&
4422 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 !&
4423 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 !&
4424
4425 beta(3) = ( v( 0)*(2107._wp*v( 0) - 9402._wp*v( 1) + 7042._wp*v( 2) - 1854._wp*v( 3)) & !&
4426 + v( 1)*( 11003._wp*v( 1) - 17246._wp*v( 2) + 4642._wp*v( 3)) & !&
4427 + v( 2)*( 7043._wp*v( 2) - 3882._wp*v( 3)) & !&
4428 + v( 3)*( 547._wp*v( 3)) ) / 240._wp & !&
4429 + weno_eps !&
4430
4431 beta(4) = ( v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v( 0)) & !&
4432 + v(-2)*( 7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v( 0)) & !&
4433 + v(-1)*( 11003._wp*v(-1) - 9402._wp*v( 0)) & !&
4434 + v( 0)*( 2107._wp*v( 0)) ) / 240._wp & !&
4435 + weno_eps !&
4436# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4437 end if
4438
4439 if (wenojs) then
4440 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4441
4442 elseif (mapped_weno) then
4443 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4444 omega = alpha/sum(alpha)
4445 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) &
4446 *(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))))
4447
4448 elseif (wenoz) then
4449 ! Castro, et al. (2010)
4450 ! Don & Borges (2013) also helps
4451 tau = abs(beta(3) - beta(0)) ! Equation 50
4452
4453# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4454#if defined(MFC_OpenACC)
4455# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4456!$acc loop seq
4457# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4458#elif defined(MFC_OpenMP)
4459# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4460
4461# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4462#endif
4463 do q = 0, weno_num_stencils
4464 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4465 end do
4466
4467 elseif (teno) then
4468# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4469 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4470 alpha = 1._wp + tau/beta
4471 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4472 omega = alpha/sum(alpha)
4473
4474
4475# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4476#if defined(MFC_OpenACC)
4477# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4478!$acc loop seq
4479# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4480#elif defined(MFC_OpenMP)
4481# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4482
4483# 1087 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4484#endif
4485 do q = 0, weno_num_stencils
4486 if (omega(q) < teno_ct) then ! Equation 26
4487 delta(q) = 0._wp
4488 else
4489 delta(q) = 1._wp
4490 end if
4491 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
4492 end do
4493# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4494 end if
4495
4496 omega = alpha/sum(alpha)
4497
4498 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4499
4500 if (teno) then
4501# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4502 vl_rs_vf_z(j, k, l, i) = vl_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
4503# 1107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4504 end if
4505
4506 if (.not. teno) then
4507 poly(3) = v_rs_ws_z(j, k, l, i) &
4508 + poly_coef_cbr_z(j, 0, 0)*dvd(2) &
4509 + poly_coef_cbr_z(j, 0, 1)*dvd(1) &
4510 + poly_coef_cbr_z(j, 0, 2)*dvd(0)
4511 poly(2) = v_rs_ws_z(j, k, l, i) &
4512 + poly_coef_cbr_z(j, 1, 0)*dvd(1) &
4513 + poly_coef_cbr_z(j, 1, 1)*dvd(0) &
4514 + poly_coef_cbr_z(j, 1, 2)*dvd(-1)
4515 poly(1) = v_rs_ws_z(j, k, l, i) &
4516 + poly_coef_cbr_z(j, 2, 0)*dvd(0) &
4517 + poly_coef_cbr_z(j, 2, 1)*dvd(-1) &
4518 + poly_coef_cbr_z(j, 2, 2)*dvd(-2)
4519 poly(0) = v_rs_ws_z(j, k, l, i) &
4520 + poly_coef_cbr_z(j, 3, 0)*dvd(-1) &
4521 + poly_coef_cbr_z(j, 3, 1)*dvd(-2) &
4522 + poly_coef_cbr_z(j, 3, 2)*dvd(-3)
4523 else
4524# 1128 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4525 poly(0) = (-1._wp*v(-1) + 5._wp*v( 0) + 2._wp*v( 1)) / 6._wp !&
4526 poly(1) = ( 2._wp*v( 0) + 5._wp*v( 1) - 1._wp*v( 2)) / 6._wp !&
4527 poly(2) = ( 2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v( 0)) / 6._wp !&
4528 poly(3) = ( 3._wp*v( 0) + 13._wp*v( 1) - 5._wp*v( 2) + 1._wp*v( 3)) / 12._wp !&
4529 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v( 0)) / 12._wp !&
4530# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4531 end if
4532
4533 if (wenojs) then
4534 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4535
4536 elseif (mapped_weno) then
4537 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, j)/(beta(0:weno_num_stencils)**2._wp)
4538 omega = alpha/sum(alpha)
4539 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) &
4540 *(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))))
4541
4542 elseif (wenoz) then
4543
4544
4545# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4546#if defined(MFC_OpenACC)
4547# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4548!$acc loop seq
4549# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4550#elif defined(MFC_OpenMP)
4551# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4552
4553# 1147 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4554#endif
4555 do q = 0, weno_num_stencils
4556 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4557 end do
4558
4559 elseif (teno) then
4560
4561# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4562#if defined(MFC_OpenACC)
4563# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4564!$acc loop seq
4565# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4566#elif defined(MFC_OpenMP)
4567# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4568
4569# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4570#endif
4571 do q = 0, weno_num_stencils
4572 alpha(q) = delta(q)*d_cbr_z(q, j)
4573 end do
4574 end if
4575
4576 omega = alpha/sum(alpha)
4577
4578 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4579
4580 if (teno) then
4581# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4582 vr_rs_vf_z(j, k, l, i) = vr_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
4583# 1167 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4584 end if
4585
4586 end do
4587 end do
4588 end do
4589 end do
4590
4591# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4592
4593# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4594#if defined(MFC_OpenACC)
4595# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4596!$acc end parallel loop
4597# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4598#elif defined(MFC_OpenMP)
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
4603# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4604!$omp end target teams loop
4605# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4606#endif
4607# 1173 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4608
4609 end if
4610# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4611# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4612 end if
4613
4614 if (int_comp) then
4615 call s_interface_compression(vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, &
4616 vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, &
4617 weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
4618 end if
4619
4620 end subroutine s_weno
4621
4622 !> The computation of parameters, the allocation of memory,
4623 !! the association of pointers and/or the execution of any
4624 !! other procedures that are required for the setup of the
4625 !! WENO reconstruction.
4626 !! @param v_vf Cell-averaged variables
4627 !! @param weno_dir Coordinate direction of the WENO reconstruction
4628 subroutine s_initialize_weno(v_vf, &
4629 weno_dir)
4630
4631 type(scalar_field), dimension(:), intent(IN) :: v_vf
4632
4633 integer, intent(IN) :: weno_dir
4634
4635 integer :: j, k, l, q
4636
4637 ! Determining the number of cell-average variables which will be
4638 ! WENO-reconstructed and mapping their indical bounds in the x-,
4639 ! y- and z-directions to those in the s1-, s2- and s3-directions
4640 ! as to reshape the inputted data in the coordinate direction of
4641 ! the WENO reconstruction
4642 v_size = ubound(v_vf, 1)
4643
4644# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4645#if defined(MFC_OpenACC)
4646# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4647!$acc update device(v_size)
4648# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4649#elif defined(MFC_OpenMP)
4650# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4651!$omp target update to(v_size)
4652# 1208 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4653#endif
4654
4655 if (weno_dir == 1) then
4656
4657# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4658
4659# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4660#if defined(MFC_OpenACC)
4661# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4662!$acc parallel loop collapse(4) gang vector default(present)
4663# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4664#elif defined(MFC_OpenMP)
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
4671# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4672!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4673# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4674#endif
4675# 1211 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4676
4677 do j = 1, v_size
4678 do q = is3_weno%beg, is3_weno%end
4679 do l = is2_weno%beg, is2_weno%end
4680 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4681 v_rs_ws_x(k, l, q, j) = v_vf(j)%sf(k, l, q)
4682 end do
4683 end do
4684 end do
4685 end do
4686
4687# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4688
4689# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4690#if defined(MFC_OpenACC)
4691# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4692!$acc end parallel loop
4693# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4694#elif defined(MFC_OpenMP)
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
4699# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4700!$omp end target teams loop
4701# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4702#endif
4703# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4704
4705 end if
4706
4707 ! Reshaping/Projecting onto Characteristic Fields in y-direction
4708 if (n == 0) return
4709
4710 if (weno_dir == 2) then
4711
4712# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4713
4714# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4715#if defined(MFC_OpenACC)
4716# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4717!$acc parallel loop collapse(4) gang vector default(present)
4718# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4719#elif defined(MFC_OpenMP)
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
4726# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4727!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4728# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4729#endif
4730# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4731
4732 do j = 1, v_size
4733 do q = is3_weno%beg, is3_weno%end
4734 do l = is2_weno%beg, is2_weno%end
4735 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4736 v_rs_ws_y(k, l, q, j) = v_vf(j)%sf(l, k, q)
4737 end do
4738 end do
4739 end do
4740 end do
4741
4742# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4743
4744# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4745#if defined(MFC_OpenACC)
4746# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4747!$acc end parallel loop
4748# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4749#elif defined(MFC_OpenMP)
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
4754# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4755!$omp end target teams loop
4756# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4757#endif
4758# 1238 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4759
4760 end if
4761
4762 ! Reshaping/Projecting onto Characteristic Fields in z-direction
4763 if (p == 0) return
4764
4765 if (weno_dir == 3) then
4766
4767# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4768
4769# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4770#if defined(MFC_OpenACC)
4771# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4772!$acc parallel loop collapse(4) gang vector default(present)
4773# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4774#elif defined(MFC_OpenMP)
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
4781# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4782!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
4783# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4784#endif
4785# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4786
4787 do j = 1, v_size
4788 do q = is3_weno%beg, is3_weno%end
4789 do l = is2_weno%beg, is2_weno%end
4790 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
4791 v_rs_ws_z(k, l, q, j) = v_vf(j)%sf(q, l, k)
4792 end do
4793 end do
4794 end do
4795 end do
4796
4797# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4798
4799# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4800#if defined(MFC_OpenACC)
4801# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4802!$acc end parallel loop
4803# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4804#elif defined(MFC_OpenMP)
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
4809# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4810!$omp end target teams loop
4811# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4812#endif
4813# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4814
4815 end if
4816
4817 end subroutine s_initialize_weno
4818
4819 !> The goal of this subroutine is to ensure that the WENO
4820 !! reconstruction is monotonic. The latter is achieved by
4821 !! enforcing monotonicity preserving bounds of Suresh and
4822 !! Huynh (1997). The resulting MPWENO reconstruction, see
4823 !! Balsara and Shu (2000), ensures that the reconstructed
4824 !! values do not reside outside the range spanned by WENO
4825 !! stencil.
4826 !! @param v_rs_ws Reshaped cell-averaged variables
4827 !! @param vL_rs_vf Left WENO reconstructed cell-boundary values
4828 !! @param vR_rs_vf Right WENO reconstructed cell-boundary values
4829 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
4830
4831 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(IN) :: v_rs_ws
4832 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(INOUT) :: vL_rs_vf, vR_rs_vf
4833
4834 integer :: i, j, k, l
4835
4836 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
4837
4838 real(wp) :: d_MD, d_LC !<
4839 !! Median (md) curvature and large curvature (LC) measures
4840
4841 ! The left and right upper bounds (UL), medians, large curvatures,
4842 ! minima, and maxima of the WENO-reconstructed values of the cell-
4843 ! average variables.
4844 real(wp) :: vL_UL, vR_UL
4845 real(wp) :: vL_MD, vR_MD
4846 real(wp) :: vL_LC, vR_LC
4847 real(wp) :: vL_min, vR_min
4848 real(wp) :: vL_max, vR_max
4849
4850 real(wp), parameter :: alpha = 2._wp !>
4851 !! Determines the maximum Courant–Friedrichs–Lewy (CFL) number that
4852 !! may be utilized with the scheme. In theory, for stability, a CFL
4853 !! number less than 1/(1+alpha) is necessary. The default value for
4854 !! alpha is 2.
4855
4856 real(wp), parameter :: beta = 4._wp/3._wp !<
4857 !! Determines the amount of freedom available from utilizing a large
4858 !! value for the local curvature. The default value for beta is 4/3.
4859
4860 real(wp), parameter :: alpha_mp = 2._wp
4861 real(wp), parameter :: beta_mp = 4._wp/3._wp
4862
4863
4864# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4865
4866# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4867#if defined(MFC_OpenACC)
4868# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4869!$acc parallel loop collapse(4) gang vector default(present) private(d)
4870# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4871#elif defined(MFC_OpenMP)
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
4878# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4879!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d)
4880# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4881#endif
4882# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4883
4884 do l = is3_weno%beg, is3_weno%end
4885 do k = is2_weno%beg, is2_weno%end
4886 do j = is1_weno%beg, is1_weno%end
4887 do i = 1, v_size
4888 d(-1) = v_rs_ws(j, k, l, i) &
4889 + v_rs_ws(j - 2, k, l, i) &
4890 - v_rs_ws(j - 1, k, l, i) &
4891 *2._wp
4892 d(0) = v_rs_ws(j + 1, k, l, i) &
4893 + v_rs_ws(j - 1, k, l, i) &
4894 - v_rs_ws(j, k, l, i) &
4895 *2._wp
4896 d(1) = v_rs_ws(j + 2, k, l, i) &
4897 + v_rs_ws(j, k, l, i) &
4898 - v_rs_ws(j + 1, k, l, i) &
4899 *2._wp
4900
4901 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) &
4902 *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) &
4903 *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) &
4904 *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
4905 abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
4906
4907 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) &
4908 *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) &
4909 *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) &
4910 *min(abs(4._wp*d(0) - d(1)), abs(d(0)), &
4911 abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
4912
4913 vl_ul = v_rs_ws(j, k, l, i) &
4914 - (v_rs_ws(j + 1, k, l, i) &
4915 - v_rs_ws(j, k, l, i))*alpha_mp
4916
4917 vl_md = (v_rs_ws(j, k, l, i) &
4918 + v_rs_ws(j - 1, k, l, i) &
4919 - d_md)*5.e-1_wp
4920
4921 vl_lc = v_rs_ws(j, k, l, i) &
4922 - (v_rs_ws(j + 1, k, l, i) &
4923 - v_rs_ws(j, k, l, i))*5.e-1_wp + beta_mp*d_lc
4924
4925 vl_min = max(min(v_rs_ws(j, k, l, i), &
4926 v_rs_ws(j - 1, k, l, i), &
4927 vl_md), &
4928 min(v_rs_ws(j, k, l, i), &
4929 vl_ul, &
4930 vl_lc))
4931
4932 vl_max = min(max(v_rs_ws(j, k, l, i), &
4933 v_rs_ws(j - 1, k, l, i), &
4934 vl_md), &
4935 max(v_rs_ws(j, k, l, i), &
4936 vl_ul, &
4937 vl_lc))
4938
4939 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) &
4940 + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, i)) &
4941 + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i))) &
4942 *min(abs(vl_min - vl_rs_vf(j, k, l, i)), &
4943 abs(vl_max - vl_rs_vf(j, k, l, i)))
4944 ! END: Left Monotonicity Preserving Bound
4945
4946 ! Right Monotonicity Preserving Bound
4947 d(-1) = v_rs_ws(j, k, l, i) &
4948 + v_rs_ws(j - 2, k, l, i) &
4949 - v_rs_ws(j - 1, k, l, i) &
4950 *2._wp
4951 d(0) = v_rs_ws(j + 1, k, l, i) &
4952 + v_rs_ws(j - 1, k, l, i) &
4953 - v_rs_ws(j, k, l, i) &
4954 *2._wp
4955 d(1) = v_rs_ws(j + 2, k, l, i) &
4956 + v_rs_ws(j, k, l, i) &
4957 - v_rs_ws(j + 1, k, l, i) &
4958 *2._wp
4959
4960 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) &
4961 *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) &
4962 *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) &
4963 *min(abs(4._wp*d(0) - d(1)), abs(d(0)), &
4964 abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
4965
4966 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) &
4967 *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) &
4968 *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) &
4969 *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
4970 abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
4971
4972 vr_ul = v_rs_ws(j, k, l, i) &
4973 + (v_rs_ws(j, k, l, i) &
4974 - v_rs_ws(j - 1, k, l, i))*alpha_mp
4975
4976 vr_md = (v_rs_ws(j, k, l, i) &
4977 + v_rs_ws(j + 1, k, l, i) &
4978 - d_md)*5.e-1_wp
4979
4980 vr_lc = v_rs_ws(j, k, l, i) &
4981 + (v_rs_ws(j, k, l, i) &
4982 - v_rs_ws(j - 1, k, l, i))*5.e-1_wp + beta_mp*d_lc
4983
4984 vr_min = max(min(v_rs_ws(j, k, l, i), &
4985 v_rs_ws(j + 1, k, l, i), &
4986 vr_md), &
4987 min(v_rs_ws(j, k, l, i), &
4988 vr_ul, &
4989 vr_lc))
4990
4991 vr_max = min(max(v_rs_ws(j, k, l, i), &
4992 v_rs_ws(j + 1, k, l, i), &
4993 vr_md), &
4994 max(v_rs_ws(j, k, l, i), &
4995 vr_ul, &
4996 vr_lc))
4997
4998 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) &
4999 + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, i)) &
5000 + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i))) &
5001 *min(abs(vr_min - vr_rs_vf(j, k, l, i)), &
5002 abs(vr_max - vr_rs_vf(j, k, l, i)))
5003 ! END: Right Monotonicity Preserving Bound
5004 end do
5005 end do
5006 end do
5007 end do
5008
5009# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5010
5011# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5012#if defined(MFC_OpenACC)
5013# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5014!$acc end parallel loop
5015# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5016#elif defined(MFC_OpenMP)
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
5021# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5022!$omp end target teams loop
5023# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5024#endif
5025# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5026
5027
5028 end subroutine s_preserve_monotonicity
5029
5030 !> Module deallocation and/or disassociation procedures
5031 impure subroutine s_finalize_weno_module()
5032
5033 if (weno_order == 1) return
5034
5035 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5036
5037 !deallocate(vL_rs_vf_x, vR_rs_vf_x)
5038#ifdef MFC_DEBUG
5039# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5040 block
5041# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5042 use iso_fortran_env, only: output_unit
5043# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5044
5045# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5046 print *, 'm_weno.fpp:1441: ', '@:DEALLOCATE(v_rs_ws_x)'
5047# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5048
5049# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5050 call flush (output_unit)
5051# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5052 end block
5053# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5054#endif
5055# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5056
5057# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5058#if defined(MFC_OpenACC)
5059# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5060!$acc exit data delete(v_rs_ws_x)
5061# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5062#elif defined(MFC_OpenMP)
5063# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5064!$omp target exit data map(release:v_rs_ws_x)
5065# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5066#endif
5067# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5068 deallocate (v_rs_ws_x)
5069
5070 ! Deallocating WENO coefficients in x-direction
5071#ifdef MFC_DEBUG
5072# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5073 block
5074# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5075 use iso_fortran_env, only: output_unit
5076# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5077
5078# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5079 print *, 'm_weno.fpp:1444: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5080# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5081
5082# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5083 call flush (output_unit)
5084# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5085 end block
5086# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5087#endif
5088# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5089
5090# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5091#if defined(MFC_OpenACC)
5092# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5093!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5094# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5095#elif defined(MFC_OpenMP)
5096# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5097!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5098# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5099#endif
5100# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5101 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5102#ifdef MFC_DEBUG
5103# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5104 block
5105# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5106 use iso_fortran_env, only: output_unit
5107# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5108
5109# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5110 print *, 'm_weno.fpp:1445: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5111# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5112
5113# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5114 call flush (output_unit)
5115# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5116 end block
5117# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5118#endif
5119# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5120
5121# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5122#if defined(MFC_OpenACC)
5123# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5124!$acc exit data delete(d_cbL_x, d_cbR_x)
5125# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126#elif defined(MFC_OpenMP)
5127# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5128!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5129# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5130#endif
5131# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5132 deallocate (d_cbl_x, d_cbr_x)
5133#ifdef MFC_DEBUG
5134# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5135 block
5136# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5137 use iso_fortran_env, only: output_unit
5138# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5139
5140# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5141 print *, 'm_weno.fpp:1446: ', '@:DEALLOCATE(beta_coef_x)'
5142# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5143
5144# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5145 call flush (output_unit)
5146# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5147 end block
5148# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5149#endif
5150# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5151
5152# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5153#if defined(MFC_OpenACC)
5154# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5155!$acc exit data delete(beta_coef_x)
5156# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5157#elif defined(MFC_OpenMP)
5158# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5159!$omp target exit data map(release:beta_coef_x)
5160# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5161#endif
5162# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5163 deallocate (beta_coef_x)
5164
5165 ! Deallocating WENO coefficients in y-direction
5166 if (n == 0) return
5167
5168 !deallocate(vL_rs_vf_y, vR_rs_vf_y)
5169#ifdef MFC_DEBUG
5170# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5171 block
5172# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5173 use iso_fortran_env, only: output_unit
5174# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5175
5176# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5177 print *, 'm_weno.fpp:1452: ', '@:DEALLOCATE(v_rs_ws_y)'
5178# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5179
5180# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5181 call flush (output_unit)
5182# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5183 end block
5184# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5185#endif
5186# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5187
5188# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5189#if defined(MFC_OpenACC)
5190# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5191!$acc exit data delete(v_rs_ws_y)
5192# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5193#elif defined(MFC_OpenMP)
5194# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5195!$omp target exit data map(release:v_rs_ws_y)
5196# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5197#endif
5198# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5199 deallocate (v_rs_ws_y)
5200
5201#ifdef MFC_DEBUG
5202# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5203 block
5204# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5205 use iso_fortran_env, only: output_unit
5206# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5207
5208# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5209 print *, 'm_weno.fpp:1454: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5210# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5211
5212# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5213 call flush (output_unit)
5214# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5215 end block
5216# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217#endif
5218# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219
5220# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221#if defined(MFC_OpenACC)
5222# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5224# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5225#elif defined(MFC_OpenMP)
5226# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5227!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5228# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5229#endif
5230# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5231 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5232#ifdef MFC_DEBUG
5233# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5234 block
5235# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5236 use iso_fortran_env, only: output_unit
5237# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5238
5239# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5240 print *, 'm_weno.fpp:1455: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5241# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5242
5243# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5244 call flush (output_unit)
5245# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5246 end block
5247# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5248#endif
5249# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5250
5251# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5252#if defined(MFC_OpenACC)
5253# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5254!$acc exit data delete(d_cbL_y, d_cbR_y)
5255# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5256#elif defined(MFC_OpenMP)
5257# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5258!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5259# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5260#endif
5261# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5262 deallocate (d_cbl_y, d_cbr_y)
5263#ifdef MFC_DEBUG
5264# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5265 block
5266# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5267 use iso_fortran_env, only: output_unit
5268# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5269
5270# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5271 print *, 'm_weno.fpp:1456: ', '@:DEALLOCATE(beta_coef_y)'
5272# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5273
5274# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5275 call flush (output_unit)
5276# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5277 end block
5278# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5279#endif
5280# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5281
5282# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5283#if defined(MFC_OpenACC)
5284# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5285!$acc exit data delete(beta_coef_y)
5286# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5287#elif defined(MFC_OpenMP)
5288# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5289!$omp target exit data map(release:beta_coef_y)
5290# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5291#endif
5292# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5293 deallocate (beta_coef_y)
5294
5295 ! Deallocating WENO coefficients in z-direction
5296 if (p == 0) return
5297
5298 !deallocate(vL_rs_vf_z, vR_rs_vf_z)
5299#ifdef MFC_DEBUG
5300# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5301 block
5302# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5303 use iso_fortran_env, only: output_unit
5304# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5305
5306# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5307 print *, 'm_weno.fpp:1462: ', '@:DEALLOCATE(v_rs_ws_z)'
5308# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5309
5310# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5311 call flush (output_unit)
5312# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5313 end block
5314# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5315#endif
5316# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5317
5318# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5319#if defined(MFC_OpenACC)
5320# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5321!$acc exit data delete(v_rs_ws_z)
5322# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5323#elif defined(MFC_OpenMP)
5324# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5325!$omp target exit data map(release:v_rs_ws_z)
5326# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5327#endif
5328# 1462 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5329 deallocate (v_rs_ws_z)
5330
5331#ifdef MFC_DEBUG
5332# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5333 block
5334# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5335 use iso_fortran_env, only: output_unit
5336# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5337
5338# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5339 print *, 'm_weno.fpp:1464: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5340# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5341
5342# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5343 call flush (output_unit)
5344# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345 end block
5346# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5347#endif
5348# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5349
5350# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5351#if defined(MFC_OpenACC)
5352# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5353!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5354# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5355#elif defined(MFC_OpenMP)
5356# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5357!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
5358# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5359#endif
5360# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5361 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
5362#ifdef MFC_DEBUG
5363# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5364 block
5365# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5366 use iso_fortran_env, only: output_unit
5367# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5368
5369# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5370 print *, 'm_weno.fpp:1465: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
5371# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5372
5373# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5374 call flush (output_unit)
5375# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5376 end block
5377# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5378#endif
5379# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5380
5381# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5382#if defined(MFC_OpenACC)
5383# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5384!$acc exit data delete(d_cbL_z, d_cbR_z)
5385# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5386#elif defined(MFC_OpenMP)
5387# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5388!$omp target exit data map(release:d_cbL_z, d_cbR_z)
5389# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5390#endif
5391# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5392 deallocate (d_cbl_z, d_cbr_z)
5393#ifdef MFC_DEBUG
5394# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5395 block
5396# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5397 use iso_fortran_env, only: output_unit
5398# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5399
5400# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5401 print *, 'm_weno.fpp:1466: ', '@:DEALLOCATE(beta_coef_z)'
5402# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5403
5404# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5405 call flush (output_unit)
5406# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5407 end block
5408# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5409#endif
5410# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5411
5412# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5413#if defined(MFC_OpenACC)
5414# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5415!$acc exit data delete(beta_coef_z)
5416# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5417#elif defined(MFC_OpenMP)
5418# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5419!$omp target exit data map(release:beta_coef_z)
5420# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5421#endif
5422# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5423 deallocate (beta_coef_z)
5424
5425 end subroutine s_finalize_weno_module
5426
5427end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1182
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1182
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1182
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:294
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:305
m_global_parameters::weno_polyn
integer weno_polyn
Degree of the WENO polynomials (polyn).
Definition m_global_parameters.fpp.f90:434
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:919
m_global_parameters::weno_order
integer weno_order
Order of the WENO reconstruction.
Definition m_global_parameters.fpp.f90:436
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:333
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:333
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:333
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:305
m_muscl
MUSCL reconstruction with interface sharpening for contact-preserving advection.
Definition m_muscl.fpp.f90:294
m_muscl::v_size
integer v_size
Definition m_muscl.fpp.f90:315
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:305
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:304
m_weno::beta_coef_y
real(wp), dimension(:, :, :), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:411
m_weno::beta_coef_z
real(wp), dimension(:, :, :), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:412
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:443
m_weno::poly_coef_cbl_x
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:350
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:466
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:443
m_weno::d_cbl_z
real(wp), dimension(:, :), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:387
m_weno::d_cbl_y
real(wp), dimension(:, :), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:386
m_weno::poly_coef_cbr_x
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:353
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:2372
m_weno::d_cbr_x
real(wp), dimension(:, :), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:389
m_weno::beta_coef_x
real(wp), dimension(:, :, :), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:410
m_weno::poly_coef_cbl_y
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:351
m_weno::d_cbr_z
real(wp), dimension(:, :), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:391
m_weno::d_cbl_x
real(wp), dimension(:, :), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:385
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:4830
m_weno::v_rs_ws_z
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_z
Definition m_weno.fpp.f90:328
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:428
m_weno::v_rs_ws_x
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_x
Definition m_weno.fpp.f90:328
m_weno::d_cbr_y
real(wp), dimension(:, :), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:390
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:443
m_weno::poly_coef_cbl_z
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:352
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:4630
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:1144
m_weno::poly_coef_cbr_z
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:355
m_weno::poly_coef_cbr_y
real(wp), dimension(:, :, :), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:354
m_weno::v_rs_ws_y
real(wp), dimension(:, :, :, :), allocatable v_rs_ws_y
Definition m_weno.fpp.f90:328
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5032
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:383