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# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 244 "/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# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 377 "/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# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 311 "/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! GPU parallel region (scalar reductions, maxval/minval)
237# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
238
239! GPU parallel loop over threads (most common GPU macro)
240# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242! Required closing for GPU_PARALLEL_LOOP
243# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! Mark routine for device compilation
246# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Declare device-resident data
249# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Inner loop within a GPU parallel region
252# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Scoped GPU data region
255# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Host code with device pointers (for MPI with GPU buffers)
258# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Allocate device memory (unscoped)
261# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Free device memory
264# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Atomic operation on device
267# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! End atomic capture block
270# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! Copy data between host and device
273# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! Synchronization barrier
276# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Import GPU library module (openacc or omp_lib)
279# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Emit code only for AMD compiler
282# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Emit code for non-Cray compilers
285# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code only for Cray compiler
288# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code for non-NVIDIA compilers
291# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295! New line at end of file is required for FYPP
296# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
297
298# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
301! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
302! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
303# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
304
305! Allocate and create GPU device memory
306# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Free GPU device memory and deallocate
309# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Cray-specific GPU pointer setup for vector fields
312# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Cray-specific GPU pointer setup for scalar fields
315# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for acoustic source spatials
318# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323! New line at end of file is required for FYPP
324# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
325
326!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
327module m_weno
328
329 use m_derived_types
330 use m_global_parameters
331 use m_variables_conversion
332 ! $:USE_GPU_MODULE()
333
334 use m_mpi_proxy
335 use m_thinc, only: s_thinc_compression
336 use m_nvtx
337
338 private; public :: s_initialize_weno_module, s_finalize_weno_module, s_weno, s_pack_weno_input_arr
339
340 !> @name The cell-average variables that will be WENO-reconstructed unpacked into an array for performance
341 !> @{
342 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_weno
343 !> @}
344
345# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
346#if defined(MFC_OpenACC)
347# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
348!$acc declare create(v_rs_weno)
349# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
350#elif defined(MFC_OpenMP)
351# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
352!$omp declare target (v_rs_weno)
353# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
354#endif
355
356 ! WENO Coefficients
357
358 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
359 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
360 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
361 !! direction.
362 !> @{
363 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
364 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
365 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
366 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
367 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
368 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
369 !> @}
370
371# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
372#if defined(MFC_OpenACC)
373# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
374!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
375# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
376#elif defined(MFC_OpenMP)
377# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
379# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
380#endif
381
382# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
383#if defined(MFC_OpenACC)
384# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
385!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
386# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
387#elif defined(MFC_OpenMP)
388# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
389!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
390# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
391#endif
392
393 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
394 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
395 !! in the relevant coordinate direction.
396 !> @{
397 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
398 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
399 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
400 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
401 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
402 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
403 !> @}
404
405# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
406#if defined(MFC_OpenACC)
407# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
408!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
409# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
410#elif defined(MFC_OpenMP)
411# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
412!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
413# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414#endif
415
416 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
417 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
418 !! relevant coordinate direction.
419 !> @{
420 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
421 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
422 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
423 !> @}
424
425# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
426#if defined(MFC_OpenACC)
427# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
428!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
429# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
430#elif defined(MFC_OpenMP)
431# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
432!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
433# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
434#endif
435
436 ! END: WENO Coefficients
437
438 integer :: v_size !< Number of WENO-reconstructed cell-average variables
439
440# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
441#if defined(MFC_OpenACC)
442# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
443!$acc declare create(v_size)
444# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
445#elif defined(MFC_OpenMP)
446# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447!$omp declare target (v_size)
448# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449#endif
450
451 logical :: uniform_grid(3) !< True if grid spacing is uniform in each direction
452
453# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
454#if defined(MFC_OpenACC)
455# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
456!$acc declare create(uniform_grid)
457# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
458#elif defined(MFC_OpenMP)
459# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
460!$omp declare target (uniform_grid)
461# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
462#endif
463
464 !> @name Indical bounds in the s1-, s2- and s3-directions
465 !> @{
466 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
467#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
468
469# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
470#if defined(MFC_OpenACC)
471# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
472!$acc declare create(is1_weno, is2_weno, is3_weno)
473# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
474#elif defined(MFC_OpenMP)
475# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
476!$omp declare target (is1_weno, is2_weno, is3_weno)
477# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
478#endif
479#endif
480 !
481 !> @}
482
483contains
484
485 !> Initialize the WENO module
486 impure subroutine s_initialize_weno_module
487
488 if (weno_order == 1) return
489
490 ! Allocating/Computing WENO Coefficients in x-direction
491 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
492 if (n == 0) then
493 is2_weno%beg = 0
494 else
495 is2_weno%beg = -buff_size
496 end if
497
498 is2_weno%end = n - is2_weno%beg
499
500 if (p == 0) then
501 is3_weno%beg = 0
502 else
503 is3_weno%beg = -buff_size
504 end if
505
506 is3_weno%end = p - is3_weno%beg
507
508#ifdef MFC_DEBUG
509# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
510 block
511# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
512 use iso_fortran_env, only: output_unit
513# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
514
515# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
516 print *, 'm_weno.fpp:109: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
517# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
518
519# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
520 call flush (output_unit)
521# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
522 end block
523# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
524#endif
525# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
526 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
527# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
528
529# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
530
531# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532#if defined(MFC_OpenACC)
533# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534!$acc enter data create(poly_coef_cbL_x)
535# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
536#elif defined(MFC_OpenMP)
537# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
538!$omp target enter data map(always,alloc:poly_coef_cbL_x)
539# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540#endif
541#ifdef MFC_DEBUG
542# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
543 block
544# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
545 use iso_fortran_env, only: output_unit
546# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
547
548# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549 print *, 'm_weno.fpp:110: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
550# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551
552# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553 call flush (output_unit)
554# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
555 end block
556# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
557#endif
558# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
559 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
560# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
561
562# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
563
564# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
565#if defined(MFC_OpenACC)
566# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
567!$acc enter data create(poly_coef_cbR_x)
568# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
569#elif defined(MFC_OpenMP)
570# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
571!$omp target enter data map(always,alloc:poly_coef_cbR_x)
572# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
573#endif
574
575#ifdef MFC_DEBUG
576# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
577 block
578# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
579 use iso_fortran_env, only: output_unit
580# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
581
582# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
583 print *, 'm_weno.fpp:112: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
584# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
585
586# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
587 call flush (output_unit)
588# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589 end block
590# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591#endif
592# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
594# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595
596# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597
598# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599#if defined(MFC_OpenACC)
600# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601!$acc enter data create(d_cbL_x)
602# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603#elif defined(MFC_OpenMP)
604# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605!$omp target enter data map(always,alloc:d_cbL_x)
606# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607#endif
608#ifdef MFC_DEBUG
609# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
610 block
611# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
612 use iso_fortran_env, only: output_unit
613# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
614
615# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
616 print *, 'm_weno.fpp:113: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
617# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
618
619# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
620 call flush (output_unit)
621# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
622 end block
623# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
624#endif
625# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
626 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
627# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
628
629# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
630
631# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
632#if defined(MFC_OpenACC)
633# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
634!$acc enter data create(d_cbR_x)
635# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
636#elif defined(MFC_OpenMP)
637# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
638!$omp target enter data map(always,alloc:d_cbR_x)
639# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
640#endif
641
642#ifdef MFC_DEBUG
643# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
644 block
645# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
646 use iso_fortran_env, only: output_unit
647# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
648
649# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
650 print *, 'm_weno.fpp:115: ', '@: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))'
651# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
652
653# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
654 call flush (output_unit)
655# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
656 end block
657# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
658#endif
659# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
660 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))
661# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662
663# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664
665# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666#if defined(MFC_OpenACC)
667# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668!$acc enter data create(beta_coef_x)
669# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670#elif defined(MFC_OpenMP)
671# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672!$omp target enter data map(always,alloc:beta_coef_x)
673# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674#endif
675# 117 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676 ! Number of cross terms for dvd = (k-1)(k-1+1)/2, where weno_polyn = k-1 Note: k-1 not k because we are using value
677 ! differences (dvd) not the values themselves
678
679 call s_compute_weno_coefficients(1, is1_weno)
680
681#ifdef MFC_DEBUG
682# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
683 block
684# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
685 use iso_fortran_env, only: output_unit
686# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
687
688# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
689 print *, 'm_weno.fpp:122: ', '@:ALLOCATE(v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
690# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
691
692# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
693 call flush (output_unit)
694# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
695 end block
696# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
697#endif
698# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
699 allocate (v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
700# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
701
702# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
703
704# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
705#if defined(MFC_OpenACC)
706# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
707!$acc enter data create(v_rs_weno)
708# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
709#elif defined(MFC_OpenMP)
710# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711!$omp target enter data map(always,alloc:v_rs_weno)
712# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713#endif
714
715 ! Allocating/Computing WENO Coefficients in y-direction
716 if (n == 0) return
717
718 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
719 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
720
721 if (p == 0) then
722 is3_weno%beg = 0
723 else
724 is3_weno%beg = -buff_size
725 end if
726
727 is3_weno%end = p - is3_weno%beg
728
729#ifdef MFC_DEBUG
730# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
731 block
732# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
733 use iso_fortran_env, only: output_unit
734# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
735
736# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737 print *, 'm_weno.fpp:138: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
738# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739
740# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741 call flush (output_unit)
742# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743 end block
744# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745#endif
746# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
748# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749
750# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751
752# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753#if defined(MFC_OpenACC)
754# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755!$acc enter data create(poly_coef_cbL_y)
756# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757#elif defined(MFC_OpenMP)
758# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759!$omp target enter data map(always,alloc:poly_coef_cbL_y)
760# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761#endif
762#ifdef MFC_DEBUG
763# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
764 block
765# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
766 use iso_fortran_env, only: output_unit
767# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
768
769# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
770 print *, 'm_weno.fpp:139: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
771# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
772
773# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
774 call flush (output_unit)
775# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
776 end block
777# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
778#endif
779# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
781# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782
783# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784
785# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786#if defined(MFC_OpenACC)
787# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788!$acc enter data create(poly_coef_cbR_y)
789# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790#elif defined(MFC_OpenMP)
791# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792!$omp target enter data map(always,alloc:poly_coef_cbR_y)
793# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794#endif
795
796#ifdef MFC_DEBUG
797# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798 block
799# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
800 use iso_fortran_env, only: output_unit
801# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
802
803# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804 print *, 'm_weno.fpp:141: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
805# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806
807# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808 call flush (output_unit)
809# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810 end block
811# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
812#endif
813# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
814 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
815# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
816
817# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
818
819# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820#if defined(MFC_OpenACC)
821# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822!$acc enter data create(d_cbL_y)
823# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
824#elif defined(MFC_OpenMP)
825# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
826!$omp target enter data map(always,alloc:d_cbL_y)
827# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828#endif
829#ifdef MFC_DEBUG
830# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
831 block
832# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
833 use iso_fortran_env, only: output_unit
834# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
835
836# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837 print *, 'm_weno.fpp:142: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
838# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839
840# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841 call flush (output_unit)
842# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843 end block
844# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
845#endif
846# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
848# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849
850# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851
852# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853#if defined(MFC_OpenACC)
854# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855!$acc enter data create(d_cbR_y)
856# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857#elif defined(MFC_OpenMP)
858# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859!$omp target enter data map(always,alloc:d_cbR_y)
860# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861#endif
862
863#ifdef MFC_DEBUG
864# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865 block
866# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
867 use iso_fortran_env, only: output_unit
868# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
869
870# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871 print *, 'm_weno.fpp:144: ', '@: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))'
872# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873
874# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875 call flush (output_unit)
876# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877 end block
878# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879#endif
880# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881 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))
882# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
883
884# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
885
886# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
887#if defined(MFC_OpenACC)
888# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
889!$acc enter data create(beta_coef_y)
890# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891#elif defined(MFC_OpenMP)
892# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893!$omp target enter data map(always,alloc:beta_coef_y)
894# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895#endif
896# 146 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897
898 call s_compute_weno_coefficients(2, is2_weno)
899
900 ! Allocating/Computing WENO Coefficients in z-direction
901 if (p == 0) return
902
903 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
904 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
905 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
906
907#ifdef MFC_DEBUG
908# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
909 block
910# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
911 use iso_fortran_env, only: output_unit
912# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
913
914# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
915 print *, 'm_weno.fpp:156: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
916# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
917
918# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
919 call flush (output_unit)
920# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
921 end block
922# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
923#endif
924# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
925 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
926# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
927
928# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
929
930# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
931#if defined(MFC_OpenACC)
932# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
933!$acc enter data create(poly_coef_cbL_z)
934# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
935#elif defined(MFC_OpenMP)
936# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
937!$omp target enter data map(always,alloc:poly_coef_cbL_z)
938# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
939#endif
940#ifdef MFC_DEBUG
941# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
942 block
943# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
944 use iso_fortran_env, only: output_unit
945# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
946
947# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
949# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950
951# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952 call flush (output_unit)
953# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954 end block
955# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956#endif
957# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
959# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960
961# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962
963# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964#if defined(MFC_OpenACC)
965# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966!$acc enter data create(poly_coef_cbR_z)
967# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968#elif defined(MFC_OpenMP)
969# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970!$omp target enter data map(always,alloc:poly_coef_cbR_z)
971# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972#endif
973
974#ifdef MFC_DEBUG
975# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976 block
977# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978 use iso_fortran_env, only: output_unit
979# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
980
981# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982 print *, 'm_weno.fpp:159: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
983# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984
985# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986 call flush (output_unit)
987# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988 end block
989# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990#endif
991# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
993# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994
995# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
996
997# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
998#if defined(MFC_OpenACC)
999# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1000!$acc enter data create(d_cbL_z)
1001# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1002#elif defined(MFC_OpenMP)
1003# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1004!$omp target enter data map(always,alloc:d_cbL_z)
1005# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1006#endif
1007#ifdef MFC_DEBUG
1008# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1009 block
1010# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1011 use iso_fortran_env, only: output_unit
1012# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1013
1014# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1016# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017
1018# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019 call flush (output_unit)
1020# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021 end block
1022# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023#endif
1024# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1026# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027
1028# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029
1030# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1031#if defined(MFC_OpenACC)
1032# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1033!$acc enter data create(d_cbR_z)
1034# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1035#elif defined(MFC_OpenMP)
1036# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1037!$omp target enter data map(always,alloc:d_cbR_z)
1038# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1039#endif
1040
1041#ifdef MFC_DEBUG
1042# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1043 block
1044# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1045 use iso_fortran_env, only: output_unit
1046# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1047
1048# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1049 print *, 'm_weno.fpp:162: ', '@: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))'
1050# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1051
1052# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1053 call flush (output_unit)
1054# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1055 end block
1056# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1057#endif
1058# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1059 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))
1060# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1061
1062# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1063
1064# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1065#if defined(MFC_OpenACC)
1066# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1067!$acc enter data create(beta_coef_z)
1068# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1069#elif defined(MFC_OpenMP)
1070# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1071!$omp target enter data map(always,alloc:beta_coef_z)
1072# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1073#endif
1074# 164 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1075
1076 call s_compute_weno_coefficients(3, is3_weno)
1077
1078 end subroutine s_initialize_weno_module
1079
1080 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1081 subroutine s_compute_weno_coefficients(weno_dir, is)
1082
1083 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1084 integer, intent(in) :: weno_dir
1085 type(int_bounds_info), intent(in) :: is
1086 integer :: s
1087 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1088 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1089 integer :: i !< Generic loop iterator
1090 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1091 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1092 real(wp) :: h0 !< Reference spacing for uniform-grid detection
1093
1094 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1095
1096 if (weno_dir == 1) then
1097 s = m; s_cb => x_cb; bc_s = bc_x
1098 else if (weno_dir == 2) then
1099 s = n; s_cb => y_cb; bc_s = bc_y
1100 else
1101 s = p; s_cb => z_cb; bc_s = bc_z
1102 end if
1103
1104# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1105 ! Computing WENO3 Coefficients
1106 if (weno_dir == 1) then
1107 if (weno_order == 3) then
1108 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1109 ! Polynomial reconstruction coefficients
1110 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1111 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1112
1113 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1114 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1115
1116 ! Ideal (linear) weights
1117 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1118 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1119
1120 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1121 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1122
1123 ! Smoothness indicator coefficients
1124 beta_coef_x(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
1125 beta_coef_x(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
1126 end do
1127
1128 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1129 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1130 if (null_weights) then
1131 if (bc_s%beg == bc_riemann_extrap) then
1132 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1133 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1134 end if
1135
1136 if (bc_s%end == bc_riemann_extrap) then
1137 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1138 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1139 end if
1140 end if
1141 ! END: Computing WENO3 Coefficients
1142
1143 ! Computing WENO5 Coefficients
1144 else if (weno_order == 5) then
1145 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1146 ! Polynomial reconstruction coefficients
1147 poly_coef_cbr_x(i + 1, 0, &
1148 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1149 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1150 poly_coef_cbr_x(i + 1, 1, &
1151 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1152 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1153 poly_coef_cbr_x(i + 1, 1, &
1154 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1155 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1156 poly_coef_cbr_x(i + 1, 2, &
1157 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1158 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1159 poly_coef_cbl_x(i + 1, 0, &
1160 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1161 & *(s_cb(i + 3) - s_cb(i + 1)))
1162 poly_coef_cbl_x(i + 1, 1, &
1163 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1164 & + 2))*(s_cb(i) - s_cb(i + 2)))
1165 poly_coef_cbl_x(i + 1, 1, &
1166 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1167 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1168 poly_coef_cbl_x(i + 1, 2, &
1169 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1170 & *(s_cb(i - 2) - s_cb(i + 1)))
1171
1172 poly_coef_cbr_x(i + 1, 0, &
1173 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1174 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1175 poly_coef_cbr_x(i + 1, 2, &
1176 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1177 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1178 poly_coef_cbl_x(i + 1, 0, &
1179 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1180 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1181 poly_coef_cbl_x(i + 1, 2, &
1182 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1183 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1184
1185 ! Ideal (linear) weights
1186 d_cbr_x(0, &
1187 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1188 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1189 d_cbr_x(2, &
1190 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1191 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1192 d_cbl_x(0, &
1193 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1194 & *(s_cb(i + 3) - s_cb(i - 1)))
1195 d_cbl_x(2, &
1196 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1197 & *(s_cb(i - 2) - s_cb(i + 3)))
1198
1199 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1200 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1201
1202 ! Smoothness indicator coefficients
1203 beta_coef_x(i + 1, 0, &
1204 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1205 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1206 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1207
1208 beta_coef_x(i + 1, 0, &
1209 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1210 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1211 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1212 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1213
1214 beta_coef_x(i + 1, 0, &
1215 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1216 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1217 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1218 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1219
1220 beta_coef_x(i + 1, 1, &
1221 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1222 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1223 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1224
1225 beta_coef_x(i + 1, 1, &
1226 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1227 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1228 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1229 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1230
1231 beta_coef_x(i + 1, 1, &
1232 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1233 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1234 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1235
1236 beta_coef_x(i + 1, 2, &
1237 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1238 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1239 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1240 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1241
1242 beta_coef_x(i + 1, 2, &
1243 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1244 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1245 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1246 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1247
1248 beta_coef_x(i + 1, 2, &
1249 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1250 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1251 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1252 end do
1253
1254 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1255 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1256 if (null_weights) then
1257 if (bc_s%beg == bc_riemann_extrap) then
1258 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1259 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1260 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1261 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1262 end if
1263
1264 if (bc_s%end == bc_riemann_extrap) then
1265 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1266 & s - 1)/sum(d_cbr_x(:,s - 1))
1267 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1268 & s - 1)/sum(d_cbl_x(:,s - 1))
1269 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1270 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1271 end if
1272 end if
1273 else
1274 if (.not. teno) then
1275 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1276 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1277 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1278 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1279 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1280 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1281 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1282 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1283 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1284 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1285 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1286 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1287
1288 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1289 d_cbr_x(0, &
1290 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1291 & *(w(1) - w(8)))
1292 d_cbr_x(1, &
1293 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1294 & *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) &
1295 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1296 & *(w(2) - w(8)))
1297 d_cbr_x(2, &
1298 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1299 & *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) &
1300 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1301 & *(w(3) - w(8)))
1302 d_cbr_x(3, &
1303 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1304 & *(w(3) - w(8)))
1305
1306 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1307 d_cbl_x(0, &
1308 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1309 & *(w(3) - w(8)))
1310 d_cbl_x(1, &
1311 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1312 & *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) &
1313 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1314 & *(w(3) - w(8)))
1315 d_cbl_x(2, &
1316 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1317 & *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) &
1318 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1319 & *(w(2) - w(8)))
1320 d_cbl_x(3, &
1321 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1322 & *(w(1) - w(8)))
1323 ! Note: Left has the reversed order of both points and coefficients compared to the right
1324
1325 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1326 poly_coef_cbr_x(i + 1, 0, &
1327 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1328 & + y(2) + y(3) + y(4)))
1329 poly_coef_cbr_x(i + 1, 0, &
1330 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1331 & + 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) &
1332 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1333 poly_coef_cbr_x(i + 1, 0, &
1334 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1335 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1336 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1337
1338 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1339 poly_coef_cbr_x(i + 1, 1, &
1340 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1341 & + y(2) + y(3) + y(4)))
1342 poly_coef_cbr_x(i + 1, 1, &
1343 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1344 & + 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) &
1345 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1346 poly_coef_cbr_x(i + 1, 1, &
1347 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1348 & + y(2) + y(3) + y(4)))
1349
1350 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1351 poly_coef_cbr_x(i + 1, 2, &
1352 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1353 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1354 poly_coef_cbr_x(i + 1, 2, &
1355 & 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 &
1356 & + 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) &
1357 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1358 poly_coef_cbr_x(i + 1, 2, &
1359 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1360 & + y(2) + y(3) + y(4)))
1361
1362 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1363 poly_coef_cbr_x(i + 1, 3, &
1364 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1365 & + 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) &
1366 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1367 poly_coef_cbr_x(i + 1, 3, &
1368 & 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) &
1369 & + 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)) &
1370 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1371 & + y(4)))
1372 poly_coef_cbr_x(i + 1, 3, &
1373 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1374 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1375
1376 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1377 poly_coef_cbl_x(i + 1, 3, &
1378 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1379 & + y(2) + y(3) + y(4)))
1380 poly_coef_cbl_x(i + 1, 3, &
1381 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1382 & + 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) &
1383 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1384 poly_coef_cbl_x(i + 1, 3, &
1385 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1386 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1387 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1388
1389 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1390 poly_coef_cbl_x(i + 1, 2, &
1391 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1392 & + y(2) + y(3) + y(4)))
1393 poly_coef_cbl_x(i + 1, 2, &
1394 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1395 & + 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) &
1396 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1397 poly_coef_cbl_x(i + 1, 2, &
1398 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1399 & + y(2) + y(3) + y(4)))
1400
1401 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1402 poly_coef_cbl_x(i + 1, 1, &
1403 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1404 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1405 poly_coef_cbl_x(i + 1, 1, &
1406 & 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 &
1407 & + 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) &
1408 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1409 poly_coef_cbl_x(i + 1, 1, &
1410 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1411 & + y(2) + y(3) + y(4)))
1412
1413 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1414 poly_coef_cbl_x(i + 1, 0, &
1415 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1416 & + 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) &
1417 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1418 poly_coef_cbl_x(i + 1, 0, &
1419 & 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) &
1420 & + 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)) &
1421 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1422 & + y(4)))
1423 poly_coef_cbl_x(i + 1, 0, &
1424 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1425 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1426
1427 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1428 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1429
1430 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1431 beta_coef_x(i + 1, 3, &
1432 & 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) &
1433 & + 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) &
1434 & **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 &
1435 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
1436 & *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) &
1437 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1438 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
1439 & *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) &
1440 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1441 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1442 beta_coef_x(i + 1, 3, &
1443 & 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) &
1444 & **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) &
1445 & + 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) &
1446 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
1447 & + 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) &
1448 & *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) &
1449 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
1450 & *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) &
1451 & **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) &
1452 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
1453 & *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) &
1454 & + 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) &
1455 & *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) &
1456 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1457 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1458 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1459 beta_coef_x(i + 1, 3, &
1460 & 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) &
1461 & **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) &
1462 & + 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) &
1463 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
1464 & + 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) &
1465 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1466 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1467 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1468 beta_coef_x(i + 1, 3, &
1469 & 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 &
1470 & + 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 &
1471 & + 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 &
1472 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
1473 & + 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) &
1474 & **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) &
1475 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
1476 & **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) &
1477 & **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) &
1478 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
1479 & **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) &
1480 & **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) &
1481 & **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) &
1482 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
1483 & **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) &
1484 & **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) &
1485 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
1486 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1487 & + 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 &
1488 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1489 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1490 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1491 & + y(3) + y(4))**2)
1492 beta_coef_x(i + 1, 3, &
1493 & 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) &
1494 & **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) &
1495 & **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) &
1496 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
1497 & *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) &
1498 & *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) &
1499 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
1500 & **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) &
1501 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1502 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1503 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1504 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1505 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1506 beta_coef_x(i + 1, 3, &
1507 & 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 &
1508 & + 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) &
1509 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1510 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1511 & + y(4))**2)
1512
1513 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1514 beta_coef_x(i + 1, 2, &
1515 & 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 &
1516 & + 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) &
1517 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1518 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1519 & + y(4))**2)
1520 beta_coef_x(i + 1, 2, &
1521 & 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 &
1522 & + 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) &
1523 & - 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 &
1524 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
1525 & + 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 &
1526 & + 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 &
1527 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
1528 & + 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) &
1529 & **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 &
1530 & - 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 &
1531 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1532 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1533 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1534 & **2)
1535 beta_coef_x(i + 1, 2, &
1536 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1537 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1538 & + 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) &
1539 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
1540 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1541 & + y(4))**2)
1542 beta_coef_x(i + 1, 2, &
1543 & 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 &
1544 & + 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 &
1545 & + 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 &
1546 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
1547 & + 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) &
1548 & **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) &
1549 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
1550 & **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) &
1551 & **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) &
1552 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
1553 & + 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) &
1554 & **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 &
1555 & + 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 &
1556 & + 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) &
1557 & **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) &
1558 & *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) &
1559 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
1560 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1561 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1562 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1563 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1564 & + y(3) + y(4))**2)
1565 beta_coef_x(i + 1, 2, &
1566 & 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) &
1567 & **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) &
1568 & *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) &
1569 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
1570 & *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) &
1571 & **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) &
1572 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
1573 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1574 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1575 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1576 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1577 & **2)
1578 beta_coef_x(i + 1, 2, &
1579 & 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 &
1580 & - 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)) &
1581 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1582
1583 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1584 beta_coef_x(i + 1, 1, &
1585 & 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 &
1586 & - 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)) &
1587 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1588 beta_coef_x(i + 1, 1, &
1589 & 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) &
1590 & *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) &
1591 & **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) &
1592 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
1593 & **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) &
1594 & **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) &
1595 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
1596 & *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) &
1597 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1598 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
1599 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1600 & + y(3) + y(4))**2)
1601 beta_coef_x(i + 1, 1, &
1602 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1603 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1604 & + 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) &
1605 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
1606 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1607 & + y(4))**2)
1608 beta_coef_x(i + 1, 1, &
1609 & 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) &
1610 & + 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) &
1611 & **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) &
1612 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
1613 & **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) &
1614 & **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) &
1615 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
1616 & **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) &
1617 & **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) &
1618 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
1619 & **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) &
1620 & - 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) &
1621 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
1622 & **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) &
1623 & *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) &
1624 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1625 & **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) &
1626 & **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) &
1627 & **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) &
1628 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
1629 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1630 beta_coef_x(i + 1, 1, &
1631 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1632 & **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) &
1633 & **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) &
1634 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
1635 & + 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) &
1636 & **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) &
1637 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
1638 & **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) &
1639 & **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 &
1640 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
1641 & - 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) &
1642 & **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) &
1643 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1644 beta_coef_x(i + 1, 1, &
1645 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1646 & **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 &
1647 & + 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) &
1648 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1649 & + y(3) + y(4))**2)
1650
1651 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1652 beta_coef_x(i + 1, 0, &
1653 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1654 & **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 &
1655 & + 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) &
1656 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1657 & + y(3) + y(4))**2)
1658 beta_coef_x(i + 1, 0, &
1659 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1660 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1661 & **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) &
1662 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
1663 & + 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) &
1664 & **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 &
1665 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
1666 & **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) &
1667 & *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 &
1668 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
1669 & + 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) &
1670 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1671 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1672 beta_coef_x(i + 1, 0, &
1673 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1674 & *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) &
1675 & + 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) &
1676 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
1677 & + 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) &
1678 & *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) &
1679 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1680 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1681 beta_coef_x(i + 1, 0, &
1682 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1683 & **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) &
1684 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1685 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
1686 & + 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) &
1687 & *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) &
1688 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
1689 & + 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) &
1690 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1691 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
1692 & **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) &
1693 & **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) &
1694 & *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) &
1695 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
1696 & **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 &
1697 & + 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) &
1698 & + 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 &
1699 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1700 & + 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) &
1701 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
1702 & **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) &
1703 & **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)) &
1704 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1705 beta_coef_x(i + 1, 0, &
1706 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1707 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1708 & **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) &
1709 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1710 & **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) &
1711 & **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) &
1712 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
1713 & + 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) &
1714 & + 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) &
1715 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
1716 & *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 &
1717 & + 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) &
1718 & *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) &
1719 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
1720 & **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)) &
1721 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1722 & + y(4))**2)
1723 beta_coef_x(i + 1, 0, &
1724 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1725 & **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) &
1726 & + 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) &
1727 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
1728 & + 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) &
1729 & **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) &
1730 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
1731 & **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) &
1732 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1733 & + y(3) + y(4))**2)
1734 end do
1735 else
1736 ! (Fu, et al., 2016) Table 2 (for right flux)
1737 d_cbl_x(0,:) = 18._wp/35._wp
1738 d_cbl_x(1,:) = 3._wp/35._wp
1739 d_cbl_x(2,:) = 9._wp/35._wp
1740 d_cbl_x(3,:) = 1._wp/35._wp
1741 d_cbl_x(4,:) = 4._wp/35._wp
1742
1743 d_cbr_x(0,:) = 18._wp/35._wp
1744 d_cbr_x(1,:) = 9._wp/35._wp
1745 d_cbr_x(2,:) = 3._wp/35._wp
1746 d_cbr_x(3,:) = 4._wp/35._wp
1747 d_cbr_x(4,:) = 1._wp/35._wp
1748 end if
1749 end if
1750 end if
1751# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1752 ! Computing WENO3 Coefficients
1753 if (weno_dir == 2) then
1754 if (weno_order == 3) then
1755 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1756 ! Polynomial reconstruction coefficients
1757 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1758 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1759
1760 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1761 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1762
1763 ! Ideal (linear) weights
1764 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1765 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1766
1767 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1768 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1769
1770 ! Smoothness indicator coefficients
1771 beta_coef_y(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
1772 beta_coef_y(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
1773 end do
1774
1775 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1776 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1777 if (null_weights) then
1778 if (bc_s%beg == bc_riemann_extrap) then
1779 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1780 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1781 end if
1782
1783 if (bc_s%end == bc_riemann_extrap) then
1784 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1785 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1786 end if
1787 end if
1788 ! END: Computing WENO3 Coefficients
1789
1790 ! Computing WENO5 Coefficients
1791 else if (weno_order == 5) then
1792 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1793 ! Polynomial reconstruction coefficients
1794 poly_coef_cbr_y(i + 1, 0, &
1795 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1796 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1797 poly_coef_cbr_y(i + 1, 1, &
1798 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1799 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1800 poly_coef_cbr_y(i + 1, 1, &
1801 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1802 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1803 poly_coef_cbr_y(i + 1, 2, &
1804 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1805 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1806 poly_coef_cbl_y(i + 1, 0, &
1807 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1808 & *(s_cb(i + 3) - s_cb(i + 1)))
1809 poly_coef_cbl_y(i + 1, 1, &
1810 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1811 & + 2))*(s_cb(i) - s_cb(i + 2)))
1812 poly_coef_cbl_y(i + 1, 1, &
1813 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1814 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1815 poly_coef_cbl_y(i + 1, 2, &
1816 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1817 & *(s_cb(i - 2) - s_cb(i + 1)))
1818
1819 poly_coef_cbr_y(i + 1, 0, &
1820 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1821 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1822 poly_coef_cbr_y(i + 1, 2, &
1823 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1824 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1825 poly_coef_cbl_y(i + 1, 0, &
1826 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1827 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1828 poly_coef_cbl_y(i + 1, 2, &
1829 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1830 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1831
1832 ! Ideal (linear) weights
1833 d_cbr_y(0, &
1834 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1835 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1836 d_cbr_y(2, &
1837 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1838 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1839 d_cbl_y(0, &
1840 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1841 & *(s_cb(i + 3) - s_cb(i - 1)))
1842 d_cbl_y(2, &
1843 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1844 & *(s_cb(i - 2) - s_cb(i + 3)))
1845
1846 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1847 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1848
1849 ! Smoothness indicator coefficients
1850 beta_coef_y(i + 1, 0, &
1851 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1852 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1853 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1854
1855 beta_coef_y(i + 1, 0, &
1856 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1857 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1858 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1859 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1860
1861 beta_coef_y(i + 1, 0, &
1862 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1863 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1864 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1865 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1866
1867 beta_coef_y(i + 1, 1, &
1868 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1869 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1870 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1871
1872 beta_coef_y(i + 1, 1, &
1873 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1874 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1875 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1876 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1877
1878 beta_coef_y(i + 1, 1, &
1879 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1880 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1881 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1882
1883 beta_coef_y(i + 1, 2, &
1884 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1885 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1886 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1887 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1888
1889 beta_coef_y(i + 1, 2, &
1890 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1891 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1892 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1893 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1894
1895 beta_coef_y(i + 1, 2, &
1896 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1897 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1898 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1899 end do
1900
1901 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1902 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1903 if (null_weights) then
1904 if (bc_s%beg == bc_riemann_extrap) then
1905 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1906 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1907 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1908 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1909 end if
1910
1911 if (bc_s%end == bc_riemann_extrap) then
1912 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1913 & s - 1)/sum(d_cbr_y(:,s - 1))
1914 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1915 & s - 1)/sum(d_cbl_y(:,s - 1))
1916 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1917 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1918 end if
1919 end if
1920 else
1921 if (.not. teno) then
1922 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1923 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1924 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1925 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1926 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1927 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1928 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1929 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1930 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1931 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1932 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1933 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1934
1935 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1936 d_cbr_y(0, &
1937 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1938 & *(w(1) - w(8)))
1939 d_cbr_y(1, &
1940 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1941 & *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) &
1942 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1943 & *(w(2) - w(8)))
1944 d_cbr_y(2, &
1945 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1946 & *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) &
1947 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1948 & *(w(3) - w(8)))
1949 d_cbr_y(3, &
1950 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1951 & *(w(3) - w(8)))
1952
1953 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1954 d_cbl_y(0, &
1955 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1956 & *(w(3) - w(8)))
1957 d_cbl_y(1, &
1958 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1959 & *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) &
1960 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1961 & *(w(3) - w(8)))
1962 d_cbl_y(2, &
1963 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1964 & *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) &
1965 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1966 & *(w(2) - w(8)))
1967 d_cbl_y(3, &
1968 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1969 & *(w(1) - w(8)))
1970 ! Note: Left has the reversed order of both points and coefficients compared to the right
1971
1972 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1973 poly_coef_cbr_y(i + 1, 0, &
1974 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1975 & + y(2) + y(3) + y(4)))
1976 poly_coef_cbr_y(i + 1, 0, &
1977 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1978 & + 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) &
1979 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1980 poly_coef_cbr_y(i + 1, 0, &
1981 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1982 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1983 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1984
1985 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1986 poly_coef_cbr_y(i + 1, 1, &
1987 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1988 & + y(2) + y(3) + y(4)))
1989 poly_coef_cbr_y(i + 1, 1, &
1990 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1991 & + 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) &
1992 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1993 poly_coef_cbr_y(i + 1, 1, &
1994 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1995 & + y(2) + y(3) + y(4)))
1996
1997 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1998 poly_coef_cbr_y(i + 1, 2, &
1999 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2000 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2001 poly_coef_cbr_y(i + 1, 2, &
2002 & 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 &
2003 & + 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) &
2004 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2005 poly_coef_cbr_y(i + 1, 2, &
2006 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2007 & + y(2) + y(3) + y(4)))
2008
2009 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2010 poly_coef_cbr_y(i + 1, 3, &
2011 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2012 & + 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) &
2013 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2014 poly_coef_cbr_y(i + 1, 3, &
2015 & 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) &
2016 & + 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)) &
2017 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2018 & + y(4)))
2019 poly_coef_cbr_y(i + 1, 3, &
2020 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2021 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2022
2023 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2024 poly_coef_cbl_y(i + 1, 3, &
2025 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2026 & + y(2) + y(3) + y(4)))
2027 poly_coef_cbl_y(i + 1, 3, &
2028 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2029 & + 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) &
2030 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2031 poly_coef_cbl_y(i + 1, 3, &
2032 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2033 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2034 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2035
2036 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2037 poly_coef_cbl_y(i + 1, 2, &
2038 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2039 & + y(2) + y(3) + y(4)))
2040 poly_coef_cbl_y(i + 1, 2, &
2041 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2042 & + 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) &
2043 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2044 poly_coef_cbl_y(i + 1, 2, &
2045 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2046 & + y(2) + y(3) + y(4)))
2047
2048 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2049 poly_coef_cbl_y(i + 1, 1, &
2050 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2051 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2052 poly_coef_cbl_y(i + 1, 1, &
2053 & 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 &
2054 & + 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) &
2055 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2056 poly_coef_cbl_y(i + 1, 1, &
2057 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2058 & + y(2) + y(3) + y(4)))
2059
2060 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2061 poly_coef_cbl_y(i + 1, 0, &
2062 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2063 & + 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) &
2064 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2065 poly_coef_cbl_y(i + 1, 0, &
2066 & 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) &
2067 & + 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)) &
2068 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2069 & + y(4)))
2070 poly_coef_cbl_y(i + 1, 0, &
2071 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2072 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2073
2074 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2075 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2076
2077 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2078 beta_coef_y(i + 1, 3, &
2079 & 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) &
2080 & + 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) &
2081 & **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 &
2082 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
2083 & *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) &
2084 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2085 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
2086 & *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) &
2087 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2088 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2089 beta_coef_y(i + 1, 3, &
2090 & 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) &
2091 & **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) &
2092 & + 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) &
2093 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
2094 & + 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) &
2095 & *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) &
2096 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
2097 & *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) &
2098 & **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) &
2099 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
2100 & *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) &
2101 & + 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) &
2102 & *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) &
2103 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2104 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2105 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2106 beta_coef_y(i + 1, 3, &
2107 & 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) &
2108 & **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) &
2109 & + 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) &
2110 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
2111 & + 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) &
2112 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2113 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2114 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2115 beta_coef_y(i + 1, 3, &
2116 & 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 &
2117 & + 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 &
2118 & + 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 &
2119 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2120 & + 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) &
2121 & **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) &
2122 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
2123 & **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) &
2124 & **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) &
2125 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
2126 & **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) &
2127 & **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) &
2128 & **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) &
2129 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
2130 & **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) &
2131 & **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) &
2132 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
2133 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2134 & + 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 &
2135 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2136 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2137 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2138 & + y(3) + y(4))**2)
2139 beta_coef_y(i + 1, 3, &
2140 & 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) &
2141 & **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) &
2142 & **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) &
2143 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
2144 & *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) &
2145 & *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) &
2146 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
2147 & **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) &
2148 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2149 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2150 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2151 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2152 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2153 beta_coef_y(i + 1, 3, &
2154 & 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 &
2155 & + 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) &
2156 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2157 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2158 & + y(4))**2)
2159
2160 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2161 beta_coef_y(i + 1, 2, &
2162 & 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 &
2163 & + 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) &
2164 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2165 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2166 & + y(4))**2)
2167 beta_coef_y(i + 1, 2, &
2168 & 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 &
2169 & + 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) &
2170 & - 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 &
2171 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
2172 & + 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 &
2173 & + 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 &
2174 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
2175 & + 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) &
2176 & **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 &
2177 & - 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 &
2178 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2179 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2180 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2181 & **2)
2182 beta_coef_y(i + 1, 2, &
2183 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2184 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2185 & + 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) &
2186 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2187 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2188 & + y(4))**2)
2189 beta_coef_y(i + 1, 2, &
2190 & 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 &
2191 & + 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 &
2192 & + 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 &
2193 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2194 & + 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) &
2195 & **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) &
2196 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
2197 & **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) &
2198 & **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) &
2199 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
2200 & + 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) &
2201 & **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 &
2202 & + 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 &
2203 & + 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) &
2204 & **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) &
2205 & *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) &
2206 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
2207 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2208 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2209 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2210 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2211 & + y(3) + y(4))**2)
2212 beta_coef_y(i + 1, 2, &
2213 & 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) &
2214 & **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) &
2215 & *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) &
2216 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
2217 & *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) &
2218 & **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) &
2219 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
2220 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2221 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2222 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2223 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2224 & **2)
2225 beta_coef_y(i + 1, 2, &
2226 & 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 &
2227 & - 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)) &
2228 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2229
2230 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2231 beta_coef_y(i + 1, 1, &
2232 & 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 &
2233 & - 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)) &
2234 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2235 beta_coef_y(i + 1, 1, &
2236 & 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) &
2237 & *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) &
2238 & **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) &
2239 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
2240 & **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) &
2241 & **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) &
2242 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
2243 & *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) &
2244 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2245 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
2246 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2247 & + y(3) + y(4))**2)
2248 beta_coef_y(i + 1, 1, &
2249 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2250 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2251 & + 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) &
2252 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2253 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2254 & + y(4))**2)
2255 beta_coef_y(i + 1, 1, &
2256 & 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) &
2257 & + 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) &
2258 & **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) &
2259 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
2260 & **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) &
2261 & **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) &
2262 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
2263 & **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) &
2264 & **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) &
2265 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
2266 & **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) &
2267 & - 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) &
2268 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
2269 & **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) &
2270 & *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) &
2271 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2272 & **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) &
2273 & **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) &
2274 & **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) &
2275 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
2276 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2277 beta_coef_y(i + 1, 1, &
2278 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2279 & **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) &
2280 & **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) &
2281 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
2282 & + 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) &
2283 & **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) &
2284 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
2285 & **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) &
2286 & **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 &
2287 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
2288 & - 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) &
2289 & **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) &
2290 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2291 beta_coef_y(i + 1, 1, &
2292 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2293 & **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 &
2294 & + 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) &
2295 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2296 & + y(3) + y(4))**2)
2297
2298 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2299 beta_coef_y(i + 1, 0, &
2300 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2301 & **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 &
2302 & + 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) &
2303 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2304 & + y(3) + y(4))**2)
2305 beta_coef_y(i + 1, 0, &
2306 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2307 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2308 & **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) &
2309 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
2310 & + 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) &
2311 & **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 &
2312 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
2313 & **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) &
2314 & *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 &
2315 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
2316 & + 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) &
2317 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2318 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2319 beta_coef_y(i + 1, 0, &
2320 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2321 & *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) &
2322 & + 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) &
2323 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
2324 & + 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) &
2325 & *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) &
2326 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2327 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2328 beta_coef_y(i + 1, 0, &
2329 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2330 & **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) &
2331 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2332 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
2333 & + 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) &
2334 & *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) &
2335 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
2336 & + 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) &
2337 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2338 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
2339 & **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) &
2340 & **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) &
2341 & *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) &
2342 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
2343 & **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 &
2344 & + 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) &
2345 & + 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 &
2346 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2347 & + 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) &
2348 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
2349 & **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) &
2350 & **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)) &
2351 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2352 beta_coef_y(i + 1, 0, &
2353 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2354 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2355 & **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) &
2356 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2357 & **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) &
2358 & **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) &
2359 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
2360 & + 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) &
2361 & + 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) &
2362 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
2363 & *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 &
2364 & + 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) &
2365 & *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) &
2366 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
2367 & **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)) &
2368 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2369 & + y(4))**2)
2370 beta_coef_y(i + 1, 0, &
2371 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2372 & **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) &
2373 & + 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) &
2374 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
2375 & + 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) &
2376 & **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) &
2377 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
2378 & **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) &
2379 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2380 & + y(3) + y(4))**2)
2381 end do
2382 else
2383 ! (Fu, et al., 2016) Table 2 (for right flux)
2384 d_cbl_y(0,:) = 18._wp/35._wp
2385 d_cbl_y(1,:) = 3._wp/35._wp
2386 d_cbl_y(2,:) = 9._wp/35._wp
2387 d_cbl_y(3,:) = 1._wp/35._wp
2388 d_cbl_y(4,:) = 4._wp/35._wp
2389
2390 d_cbr_y(0,:) = 18._wp/35._wp
2391 d_cbr_y(1,:) = 9._wp/35._wp
2392 d_cbr_y(2,:) = 3._wp/35._wp
2393 d_cbr_y(3,:) = 4._wp/35._wp
2394 d_cbr_y(4,:) = 1._wp/35._wp
2395 end if
2396 end if
2397 end if
2398# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2399 ! Computing WENO3 Coefficients
2400 if (weno_dir == 3) then
2401 if (weno_order == 3) then
2402 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2403 ! Polynomial reconstruction coefficients
2404 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2405 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2406
2407 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2408 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2409
2410 ! Ideal (linear) weights
2411 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2412 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2413
2414 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2415 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2416
2417 ! Smoothness indicator coefficients
2418 beta_coef_z(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
2419 beta_coef_z(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
2420 end do
2421
2422 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2423 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2424 if (null_weights) then
2425 if (bc_s%beg == bc_riemann_extrap) then
2426 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2427 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2428 end if
2429
2430 if (bc_s%end == bc_riemann_extrap) then
2431 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2432 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2433 end if
2434 end if
2435 ! END: Computing WENO3 Coefficients
2436
2437 ! Computing WENO5 Coefficients
2438 else if (weno_order == 5) then
2439 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2440 ! Polynomial reconstruction coefficients
2441 poly_coef_cbr_z(i + 1, 0, &
2442 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2443 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2444 poly_coef_cbr_z(i + 1, 1, &
2445 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2446 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2447 poly_coef_cbr_z(i + 1, 1, &
2448 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2449 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2450 poly_coef_cbr_z(i + 1, 2, &
2451 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2452 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2453 poly_coef_cbl_z(i + 1, 0, &
2454 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2455 & *(s_cb(i + 3) - s_cb(i + 1)))
2456 poly_coef_cbl_z(i + 1, 1, &
2457 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2458 & + 2))*(s_cb(i) - s_cb(i + 2)))
2459 poly_coef_cbl_z(i + 1, 1, &
2460 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2461 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2462 poly_coef_cbl_z(i + 1, 2, &
2463 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2464 & *(s_cb(i - 2) - s_cb(i + 1)))
2465
2466 poly_coef_cbr_z(i + 1, 0, &
2467 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2468 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2469 poly_coef_cbr_z(i + 1, 2, &
2470 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2471 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2472 poly_coef_cbl_z(i + 1, 0, &
2473 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2474 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2475 poly_coef_cbl_z(i + 1, 2, &
2476 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2477 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2478
2479 ! Ideal (linear) weights
2480 d_cbr_z(0, &
2481 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2482 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2483 d_cbr_z(2, &
2484 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2485 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2486 d_cbl_z(0, &
2487 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2488 & *(s_cb(i + 3) - s_cb(i - 1)))
2489 d_cbl_z(2, &
2490 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2491 & *(s_cb(i - 2) - s_cb(i + 3)))
2492
2493 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2494 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2495
2496 ! Smoothness indicator coefficients
2497 beta_coef_z(i + 1, 0, &
2498 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2499 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2500 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2501
2502 beta_coef_z(i + 1, 0, &
2503 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2504 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2505 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2506 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2507
2508 beta_coef_z(i + 1, 0, &
2509 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2510 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2511 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2512 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2513
2514 beta_coef_z(i + 1, 1, &
2515 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2516 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2517 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2518
2519 beta_coef_z(i + 1, 1, &
2520 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2521 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2522 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2523 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2524
2525 beta_coef_z(i + 1, 1, &
2526 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2527 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2528 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2529
2530 beta_coef_z(i + 1, 2, &
2531 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2532 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2533 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2534 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2535
2536 beta_coef_z(i + 1, 2, &
2537 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2538 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2539 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2540 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2541
2542 beta_coef_z(i + 1, 2, &
2543 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2544 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2545 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2546 end do
2547
2548 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2549 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2550 if (null_weights) then
2551 if (bc_s%beg == bc_riemann_extrap) then
2552 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2553 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2554 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2555 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2556 end if
2557
2558 if (bc_s%end == bc_riemann_extrap) then
2559 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2560 & s - 1)/sum(d_cbr_z(:,s - 1))
2561 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2562 & s - 1)/sum(d_cbl_z(:,s - 1))
2563 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2564 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2565 end if
2566 end if
2567 else
2568 if (.not. teno) then
2569 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2570 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2571 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2572 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2573 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2574 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2575 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2576 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2577 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2578 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2579 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2580 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2581
2582 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2583 d_cbr_z(0, &
2584 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2585 & *(w(1) - w(8)))
2586 d_cbr_z(1, &
2587 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2588 & *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) &
2589 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2590 & *(w(2) - w(8)))
2591 d_cbr_z(2, &
2592 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2593 & *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) &
2594 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2595 & *(w(3) - w(8)))
2596 d_cbr_z(3, &
2597 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2598 & *(w(3) - w(8)))
2599
2600 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2601 d_cbl_z(0, &
2602 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2603 & *(w(3) - w(8)))
2604 d_cbl_z(1, &
2605 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2606 & *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) &
2607 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2608 & *(w(3) - w(8)))
2609 d_cbl_z(2, &
2610 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2611 & *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) &
2612 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2613 & *(w(2) - w(8)))
2614 d_cbl_z(3, &
2615 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2616 & *(w(1) - w(8)))
2617 ! Note: Left has the reversed order of both points and coefficients compared to the right
2618
2619 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2620 poly_coef_cbr_z(i + 1, 0, &
2621 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2622 & + y(2) + y(3) + y(4)))
2623 poly_coef_cbr_z(i + 1, 0, &
2624 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2625 & + 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) &
2626 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2627 poly_coef_cbr_z(i + 1, 0, &
2628 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2629 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2630 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2631
2632 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2633 poly_coef_cbr_z(i + 1, 1, &
2634 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2635 & + y(2) + y(3) + y(4)))
2636 poly_coef_cbr_z(i + 1, 1, &
2637 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2638 & + 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) &
2639 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2640 poly_coef_cbr_z(i + 1, 1, &
2641 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2642 & + y(2) + y(3) + y(4)))
2643
2644 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2645 poly_coef_cbr_z(i + 1, 2, &
2646 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2647 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2648 poly_coef_cbr_z(i + 1, 2, &
2649 & 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 &
2650 & + 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) &
2651 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2652 poly_coef_cbr_z(i + 1, 2, &
2653 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2654 & + y(2) + y(3) + y(4)))
2655
2656 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2657 poly_coef_cbr_z(i + 1, 3, &
2658 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2659 & + 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) &
2660 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2661 poly_coef_cbr_z(i + 1, 3, &
2662 & 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) &
2663 & + 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)) &
2664 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2665 & + y(4)))
2666 poly_coef_cbr_z(i + 1, 3, &
2667 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2668 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2669
2670 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2671 poly_coef_cbl_z(i + 1, 3, &
2672 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2673 & + y(2) + y(3) + y(4)))
2674 poly_coef_cbl_z(i + 1, 3, &
2675 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2676 & + 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) &
2677 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2678 poly_coef_cbl_z(i + 1, 3, &
2679 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2680 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2681 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2682
2683 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2684 poly_coef_cbl_z(i + 1, 2, &
2685 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2686 & + y(2) + y(3) + y(4)))
2687 poly_coef_cbl_z(i + 1, 2, &
2688 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2689 & + 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) &
2690 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2691 poly_coef_cbl_z(i + 1, 2, &
2692 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2693 & + y(2) + y(3) + y(4)))
2694
2695 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2696 poly_coef_cbl_z(i + 1, 1, &
2697 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2698 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2699 poly_coef_cbl_z(i + 1, 1, &
2700 & 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 &
2701 & + 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) &
2702 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2703 poly_coef_cbl_z(i + 1, 1, &
2704 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2705 & + y(2) + y(3) + y(4)))
2706
2707 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2708 poly_coef_cbl_z(i + 1, 0, &
2709 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2710 & + 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) &
2711 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2712 poly_coef_cbl_z(i + 1, 0, &
2713 & 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) &
2714 & + 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)) &
2715 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2716 & + y(4)))
2717 poly_coef_cbl_z(i + 1, 0, &
2718 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2719 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2720
2721 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2722 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2723
2724 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2725 beta_coef_z(i + 1, 3, &
2726 & 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) &
2727 & + 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) &
2728 & **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 &
2729 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
2730 & *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) &
2731 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2732 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
2733 & *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) &
2734 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2735 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2736 beta_coef_z(i + 1, 3, &
2737 & 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) &
2738 & **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) &
2739 & + 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) &
2740 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
2741 & + 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) &
2742 & *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) &
2743 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
2744 & *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) &
2745 & **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) &
2746 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
2747 & *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) &
2748 & + 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) &
2749 & *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) &
2750 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2751 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2752 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2753 beta_coef_z(i + 1, 3, &
2754 & 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) &
2755 & **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) &
2756 & + 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) &
2757 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
2758 & + 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) &
2759 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2760 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2761 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2762 beta_coef_z(i + 1, 3, &
2763 & 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 &
2764 & + 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 &
2765 & + 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 &
2766 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2767 & + 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) &
2768 & **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) &
2769 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
2770 & **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) &
2771 & **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) &
2772 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
2773 & **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) &
2774 & **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) &
2775 & **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) &
2776 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
2777 & **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) &
2778 & **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) &
2779 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
2780 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2781 & + 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 &
2782 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2783 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2784 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2785 & + y(3) + y(4))**2)
2786 beta_coef_z(i + 1, 3, &
2787 & 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) &
2788 & **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) &
2789 & **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) &
2790 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
2791 & *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) &
2792 & *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) &
2793 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
2794 & **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) &
2795 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2796 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2797 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2798 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2799 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2800 beta_coef_z(i + 1, 3, &
2801 & 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 &
2802 & + 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) &
2803 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2804 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2805 & + y(4))**2)
2806
2807 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2808 beta_coef_z(i + 1, 2, &
2809 & 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 &
2810 & + 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) &
2811 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2812 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2813 & + y(4))**2)
2814 beta_coef_z(i + 1, 2, &
2815 & 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 &
2816 & + 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) &
2817 & - 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 &
2818 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
2819 & + 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 &
2820 & + 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 &
2821 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
2822 & + 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) &
2823 & **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 &
2824 & - 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 &
2825 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2826 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2827 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2828 & **2)
2829 beta_coef_z(i + 1, 2, &
2830 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2831 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2832 & + 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) &
2833 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2834 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2835 & + y(4))**2)
2836 beta_coef_z(i + 1, 2, &
2837 & 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 &
2838 & + 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 &
2839 & + 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 &
2840 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2841 & + 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) &
2842 & **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) &
2843 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
2844 & **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) &
2845 & **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) &
2846 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
2847 & + 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) &
2848 & **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 &
2849 & + 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 &
2850 & + 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) &
2851 & **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) &
2852 & *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) &
2853 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
2854 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2855 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2856 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2857 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2858 & + y(3) + y(4))**2)
2859 beta_coef_z(i + 1, 2, &
2860 & 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) &
2861 & **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) &
2862 & *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) &
2863 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
2864 & *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) &
2865 & **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) &
2866 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
2867 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2868 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2869 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2870 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2871 & **2)
2872 beta_coef_z(i + 1, 2, &
2873 & 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 &
2874 & - 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)) &
2875 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2876
2877 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2878 beta_coef_z(i + 1, 1, &
2879 & 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 &
2880 & - 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)) &
2881 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2882 beta_coef_z(i + 1, 1, &
2883 & 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) &
2884 & *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) &
2885 & **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) &
2886 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
2887 & **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) &
2888 & **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) &
2889 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
2890 & *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) &
2891 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2892 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
2893 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2894 & + y(3) + y(4))**2)
2895 beta_coef_z(i + 1, 1, &
2896 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2897 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2898 & + 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) &
2899 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2900 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2901 & + y(4))**2)
2902 beta_coef_z(i + 1, 1, &
2903 & 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) &
2904 & + 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) &
2905 & **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) &
2906 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
2907 & **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) &
2908 & **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) &
2909 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
2910 & **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) &
2911 & **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) &
2912 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
2913 & **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) &
2914 & - 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) &
2915 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
2916 & **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) &
2917 & *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) &
2918 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2919 & **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) &
2920 & **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) &
2921 & **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) &
2922 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
2923 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2924 beta_coef_z(i + 1, 1, &
2925 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2926 & **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) &
2927 & **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) &
2928 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
2929 & + 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) &
2930 & **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) &
2931 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
2932 & **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) &
2933 & **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 &
2934 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
2935 & - 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) &
2936 & **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) &
2937 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2938 beta_coef_z(i + 1, 1, &
2939 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2940 & **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 &
2941 & + 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) &
2942 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2943 & + y(3) + y(4))**2)
2944
2945 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2946 beta_coef_z(i + 1, 0, &
2947 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2948 & **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 &
2949 & + 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) &
2950 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2951 & + y(3) + y(4))**2)
2952 beta_coef_z(i + 1, 0, &
2953 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2954 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2955 & **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) &
2956 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
2957 & + 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) &
2958 & **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 &
2959 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
2960 & **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) &
2961 & *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 &
2962 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
2963 & + 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) &
2964 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2965 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2966 beta_coef_z(i + 1, 0, &
2967 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2968 & *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) &
2969 & + 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) &
2970 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
2971 & + 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) &
2972 & *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) &
2973 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2974 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2975 beta_coef_z(i + 1, 0, &
2976 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2977 & **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) &
2978 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2979 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
2980 & + 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) &
2981 & *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) &
2982 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
2983 & + 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) &
2984 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2985 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
2986 & **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) &
2987 & **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) &
2988 & *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) &
2989 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
2990 & **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 &
2991 & + 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) &
2992 & + 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 &
2993 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2994 & + 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) &
2995 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
2996 & **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) &
2997 & **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)) &
2998 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2999 beta_coef_z(i + 1, 0, &
3000 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3001 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3002 & **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) &
3003 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3004 & **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) &
3005 & **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) &
3006 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
3007 & + 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) &
3008 & + 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) &
3009 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
3010 & *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 &
3011 & + 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) &
3012 & *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) &
3013 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
3014 & **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)) &
3015 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3016 & + y(4))**2)
3017 beta_coef_z(i + 1, 0, &
3018 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3019 & **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) &
3020 & + 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) &
3021 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
3022 & + 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) &
3023 & **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) &
3024 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
3025 & **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) &
3026 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3027 & + y(3) + y(4))**2)
3028 end do
3029 else
3030 ! (Fu, et al., 2016) Table 2 (for right flux)
3031 d_cbl_z(0,:) = 18._wp/35._wp
3032 d_cbl_z(1,:) = 3._wp/35._wp
3033 d_cbl_z(2,:) = 9._wp/35._wp
3034 d_cbl_z(3,:) = 1._wp/35._wp
3035 d_cbl_z(4,:) = 4._wp/35._wp
3036
3037 d_cbr_z(0,:) = 18._wp/35._wp
3038 d_cbr_z(1,:) = 9._wp/35._wp
3039 d_cbr_z(2,:) = 3._wp/35._wp
3040 d_cbr_z(3,:) = 4._wp/35._wp
3041 d_cbr_z(4,:) = 1._wp/35._wp
3042 end if
3043 end if
3044 end if
3045# 841 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3046
3047 ! Detect whether grid spacing is uniform (enables cancellation-free sum-of-squares beta). Tolerance uses sqrt(epsilon) so it
3048 ! works in both double and single precision: ~1.5e-8 relative in double, ~3.5e-4 in single - above FP noise, below real
3049 ! stretching.
3050 uniform_grid(weno_dir) = .true.
3051 h0 = (s_cb(s) - s_cb(0))/real(s, wp)
3052 do i = 0, s - 1
3053 if (abs((s_cb(i + 1) - s_cb(i)) - h0) > sqrt(epsilon(h0))*abs(h0)) then
3054 uniform_grid(weno_dir) = .false.
3055 exit
3056 end if
3057 end do
3058
3059 if (weno_dir == 1) then
3060
3061# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3062#if defined(MFC_OpenACC)
3063# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3064!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3065# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3066#elif defined(MFC_OpenMP)
3067# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3068!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3069# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3070#endif
3071 else if (weno_dir == 2) then
3072
3073# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3074#if defined(MFC_OpenACC)
3075# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3076!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3077# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3078#elif defined(MFC_OpenMP)
3079# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3080!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3081# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3082#endif
3083 else
3084
3085# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3086#if defined(MFC_OpenACC)
3087# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3088!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3089# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3090#elif defined(MFC_OpenMP)
3091# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3092!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3093# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3094#endif
3095 end if
3096
3097 ! Nullifying WENO coefficients and cell-boundary locations pointers
3098
3099 nullify (s_cb)
3100
3101 end subroutine s_compute_weno_coefficients
3102
3103 subroutine s_pack_weno_input_arr(v_vf)
3104
3105 type(scalar_field), dimension(1:), intent(in) :: v_vf
3106 integer :: i, j, k, l, n_vars
3107
3108
3109# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3110
3111# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3112#if defined(MFC_OpenACC)
3113# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3114!$acc parallel loop collapse(4) gang vector default(present)
3115# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3116#elif defined(MFC_OpenMP)
3117# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3118
3119# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3120
3121# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3122
3123# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3124!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3125# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3126#endif
3127 do i = 1, v_size
3128 do l = idwbuff(3)%beg, idwbuff(3)%end
3129 do k = idwbuff(2)%beg, idwbuff(2)%end
3130 do j = idwbuff(1)%beg, idwbuff(1)%end
3131 v_rs_weno(j, k, l, i) = v_vf(i)%sf(j, k, l)
3132 end do
3133 end do
3134 end do
3135 end do
3136
3137# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3138#if defined(MFC_OpenACC)
3139# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3140!$acc end parallel loop
3141# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3142#elif defined(MFC_OpenMP)
3143# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3144
3145# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3146!$omp end target teams loop
3147# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3148#endif
3149
3150 end subroutine s_pack_weno_input_arr
3151
3152 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3153 subroutine s_weno(v_vf, vL_rs_vf_x, vR_rs_vf_x, weno_dir, is1_weno_d, &
3154
3155 & is2_weno_d, is3_weno_d)
3156
3157 type(scalar_field), dimension(1:), intent(in) :: v_vf
3158 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x
3159 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x
3160 integer, intent(in) :: weno_dir
3161 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3162
3163# 906 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3164 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3165 real(wp), dimension(0:weno_num_stencils) :: poly
3166 real(wp), dimension(0:weno_num_stencils) :: alpha
3167 real(wp), dimension(0:weno_num_stencils) :: omega
3168 real(wp), dimension(0:weno_num_stencils) :: beta
3169 real(wp), dimension(0:weno_num_stencils) :: delta
3170# 913 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3171 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3172 real(wp) :: tau
3173 integer :: i, j, k, l, q
3174 real(wp) :: vp0, vp1, vp2, vp3, vm1, vm2, vm3
3175
3176 is1_weno = is1_weno_d
3177 is2_weno = is2_weno_d
3178 is3_weno = is3_weno_d
3179
3180
3181# 922 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3182#if defined(MFC_OpenACC)
3183# 922 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3184!$acc update device(is1_weno, is2_weno, is3_weno)
3185# 922 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3186#elif defined(MFC_OpenMP)
3187# 922 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3188!$omp target update to(is1_weno, is2_weno, is3_weno)
3189# 922 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3190#endif
3191
3192 v_size = ubound(v_vf, 1)
3193
3194# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3195#if defined(MFC_OpenACC)
3196# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3197!$acc update device(v_size)
3198# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199#elif defined(MFC_OpenMP)
3200# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201!$omp target update to(v_size)
3202# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203#endif
3204
3205 if (weno_order == 1) then
3206 if (weno_dir == 1) then
3207
3208# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3209
3210# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3211#if defined(MFC_OpenACC)
3212# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3213!$acc parallel loop collapse(4) gang vector default(present)
3214# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3215#elif defined(MFC_OpenMP)
3216# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3217
3218# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3219
3220# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3221
3222# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3223!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3224# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3225#endif
3226 do i = 1, v_size
3227 do l = is3_weno%beg, is3_weno%end
3228 do k = is2_weno%beg, is2_weno%end
3229 do j = is1_weno%beg, is1_weno%end
3230 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3231 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3232 end do
3233 end do
3234 end do
3235 end do
3236
3237# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3238#if defined(MFC_OpenACC)
3239# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3240!$acc end parallel loop
3241# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3242#elif defined(MFC_OpenMP)
3243# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3244
3245# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3246!$omp end target teams loop
3247# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3248#endif
3249 else if (weno_dir == 2) then
3250
3251# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3252
3253# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3254#if defined(MFC_OpenACC)
3255# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3256!$acc parallel loop collapse(4) gang vector default(present)
3257# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3258#elif defined(MFC_OpenMP)
3259# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3260
3261# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3262
3263# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3264
3265# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3266!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3267# 942 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3268#endif
3269 do i = 1, v_size
3270 do l = is3_weno%beg, is3_weno%end
3271 do j = is1_weno%beg, is1_weno%end
3272 do k = is2_weno%beg, is2_weno%end
3273 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3274 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3275 end do
3276 end do
3277 end do
3278 end do
3279
3280# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3281#if defined(MFC_OpenACC)
3282# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3283!$acc end parallel loop
3284# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285#elif defined(MFC_OpenMP)
3286# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3287
3288# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3289!$omp end target teams loop
3290# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3291#endif
3292 else if (weno_dir == 3) then
3293
3294# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3295
3296# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3297#if defined(MFC_OpenACC)
3298# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3299!$acc parallel loop collapse(4) gang vector default(present)
3300# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3301#elif defined(MFC_OpenMP)
3302# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3303
3304# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3305
3306# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3307
3308# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3309!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3310# 955 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3311#endif
3312 do i = 1, v_size
3313 do j = is1_weno%beg, is1_weno%end
3314 do k = is2_weno%beg, is2_weno%end
3315 do l = is3_weno%beg, is3_weno%end
3316 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3317 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3318 end do
3319 end do
3320 end do
3321 end do
3322
3323# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3324#if defined(MFC_OpenACC)
3325# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3326!$acc end parallel loop
3327# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3328#elif defined(MFC_OpenMP)
3329# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3330
3331# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3332!$omp end target teams loop
3333# 966 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3334#endif
3335 end if
3336 end if
3337
3338 if (weno_order /= 1) then
3339 call s_pack_weno_input_arr(v_vf)
3340 end if
3341
3342 if (weno_order == 3) then
3343# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3344# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3345# 981 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3346 if (weno_dir == 1) then
3347
3348# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3349
3350# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3351#if defined(MFC_OpenACC)
3352# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3353!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3354# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3355#elif defined(MFC_OpenMP)
3356# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3357
3358# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3359
3360# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3361
3362# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3363!$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, q, vp0, vp1, vm1)
3364# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3365#endif
3366 do l = is3_weno%beg, is3_weno%end
3367 do k = is2_weno%beg, is2_weno%end
3368 do j = is1_weno%beg, is1_weno%end
3369 do i = 1, v_size
3370 ! reconstruct from left side
3371
3372 alpha(:) = 0._wp
3373
3374 vp0 = v_rs_weno(j, k, l, i)
3375 vm1 = v_rs_weno(j - 1, k, l, i)
3376 vp1 = v_rs_weno(j + 1, k, l, i)
3377
3378 dvd(0) = vp1 - vp0
3379 dvd(-1) = vp0 - vm1
3380
3381 poly(0) = vp0 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3382 poly(1) = vp0 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3383
3384 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3385 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3386
3387 if (wenojs) then
3388 do q = 0, weno_num_stencils
3389 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3390 end do
3391 else if (mapped_weno) then
3392 do q = 0, weno_num_stencils
3393 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3394 end do
3395 omega = alpha/sum(alpha)
3396 do q = 0, weno_num_stencils
3397 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3398 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3399 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3400 end do
3401 else if (wenoz) then
3402 ! Borges, et al. (2008)
3403 tau = abs(beta(1) - beta(0))
3404 do q = 0, weno_num_stencils
3405 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3406 end do
3407 end if
3408 omega = alpha/sum(alpha)
3409
3410 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3411
3412 ! reconstruct from right side
3413
3414 poly(0) = vp0 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3415 poly(1) = vp0 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3416
3417 if (wenojs) then
3418 do q = 0, weno_num_stencils
3419 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3420 end do
3421 else if (mapped_weno) then
3422 do q = 0, weno_num_stencils
3423 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3424 end do
3425 omega = alpha/sum(alpha)
3426 do q = 0, weno_num_stencils
3427 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3428 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3429 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3430 end do
3431 else if (wenoz) then
3432 do q = 0, weno_num_stencils
3433 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3434 end do
3435 end if
3436 omega = alpha/sum(alpha)
3437
3438 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3439 end do
3440 end do
3441 end do
3442 end do
3443
3444# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3445#if defined(MFC_OpenACC)
3446# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3447!$acc end parallel loop
3448# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3449#elif defined(MFC_OpenMP)
3450# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3451
3452# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3453!$omp end target teams loop
3454# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3455#endif
3456 end if
3457# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3458# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3459# 981 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3460 if (weno_dir == 2) then
3461
3462# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3463
3464# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3465#if defined(MFC_OpenACC)
3466# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3467!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3468# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3469#elif defined(MFC_OpenMP)
3470# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3471
3472# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3473
3474# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3475
3476# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3477!$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, q, vp0, vp1, vm1)
3478# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3479#endif
3480 do l = is3_weno%beg, is3_weno%end
3481 do k = is1_weno%beg, is1_weno%end
3482 do j = is2_weno%beg, is2_weno%end
3483 do i = 1, v_size
3484 ! reconstruct from left side
3485
3486 alpha(:) = 0._wp
3487
3488 vp0 = v_rs_weno(j, k, l, i)
3489 vm1 = v_rs_weno(j, k - 1, l, i)
3490 vp1 = v_rs_weno(j, k + 1, l, i)
3491
3492 dvd(0) = vp1 - vp0
3493 dvd(-1) = vp0 - vm1
3494
3495 poly(0) = vp0 + poly_coef_cbl_y(k, 0, 0)*dvd(0)
3496 poly(1) = vp0 + poly_coef_cbl_y(k, 1, 0)*dvd(-1)
3497
3498 beta(0) = beta_coef_y(k, 0, 0)*dvd(0)*dvd(0) + weno_eps
3499 beta(1) = beta_coef_y(k, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3500
3501 if (wenojs) then
3502 do q = 0, weno_num_stencils
3503 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3504 end do
3505 else if (mapped_weno) then
3506 do q = 0, weno_num_stencils
3507 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3508 end do
3509 omega = alpha/sum(alpha)
3510 do q = 0, weno_num_stencils
3511 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
3512 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3513 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
3514 end do
3515 else if (wenoz) then
3516 ! Borges, et al. (2008)
3517 tau = abs(beta(1) - beta(0))
3518 do q = 0, weno_num_stencils
3519 alpha(q) = d_cbl_y(q, k)*(1._wp + tau/beta(q))
3520 end do
3521 end if
3522 omega = alpha/sum(alpha)
3523
3524 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3525
3526 ! reconstruct from right side
3527
3528 poly(0) = vp0 + poly_coef_cbr_y(k, 0, 0)*dvd(0)
3529 poly(1) = vp0 + poly_coef_cbr_y(k, 1, 0)*dvd(-1)
3530
3531 if (wenojs) then
3532 do q = 0, weno_num_stencils
3533 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3534 end do
3535 else if (mapped_weno) then
3536 do q = 0, weno_num_stencils
3537 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3538 end do
3539 omega = alpha/sum(alpha)
3540 do q = 0, weno_num_stencils
3541 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
3542 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3543 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
3544 end do
3545 else if (wenoz) then
3546 do q = 0, weno_num_stencils
3547 alpha(q) = d_cbr_y(q, k)*(1._wp + tau/beta(q))
3548 end do
3549 end if
3550 omega = alpha/sum(alpha)
3551
3552 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3553 end do
3554 end do
3555 end do
3556 end do
3557
3558# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3559#if defined(MFC_OpenACC)
3560# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3561!$acc end parallel loop
3562# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3563#elif defined(MFC_OpenMP)
3564# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3565
3566# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3567!$omp end target teams loop
3568# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3569#endif
3570 end if
3571# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3572# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3573# 981 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3574 if (weno_dir == 3) then
3575
3576# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3577
3578# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3579#if defined(MFC_OpenACC)
3580# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3581!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3582# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3583#elif defined(MFC_OpenMP)
3584# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3585
3586# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3587
3588# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3589
3590# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3591!$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, q, vp0, vp1, vm1)
3592# 982 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3593#endif
3594 do l = is1_weno%beg, is1_weno%end
3595 do k = is2_weno%beg, is2_weno%end
3596 do j = is3_weno%beg, is3_weno%end
3597 do i = 1, v_size
3598 ! reconstruct from left side
3599
3600 alpha(:) = 0._wp
3601
3602 vp0 = v_rs_weno(j, k, l, i)
3603 vm1 = v_rs_weno(j, k, l - 1, i)
3604 vp1 = v_rs_weno(j, k, l + 1, i)
3605
3606 dvd(0) = vp1 - vp0
3607 dvd(-1) = vp0 - vm1
3608
3609 poly(0) = vp0 + poly_coef_cbl_z(l, 0, 0)*dvd(0)
3610 poly(1) = vp0 + poly_coef_cbl_z(l, 1, 0)*dvd(-1)
3611
3612 beta(0) = beta_coef_z(l, 0, 0)*dvd(0)*dvd(0) + weno_eps
3613 beta(1) = beta_coef_z(l, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3614
3615 if (wenojs) then
3616 do q = 0, weno_num_stencils
3617 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3618 end do
3619 else if (mapped_weno) then
3620 do q = 0, weno_num_stencils
3621 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3622 end do
3623 omega = alpha/sum(alpha)
3624 do q = 0, weno_num_stencils
3625 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
3626 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3627 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
3628 end do
3629 else if (wenoz) then
3630 ! Borges, et al. (2008)
3631 tau = abs(beta(1) - beta(0))
3632 do q = 0, weno_num_stencils
3633 alpha(q) = d_cbl_z(q, l)*(1._wp + tau/beta(q))
3634 end do
3635 end if
3636 omega = alpha/sum(alpha)
3637
3638 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3639
3640 ! reconstruct from right side
3641
3642 poly(0) = vp0 + poly_coef_cbr_z(l, 0, 0)*dvd(0)
3643 poly(1) = vp0 + poly_coef_cbr_z(l, 1, 0)*dvd(-1)
3644
3645 if (wenojs) then
3646 do q = 0, weno_num_stencils
3647 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3648 end do
3649 else if (mapped_weno) then
3650 do q = 0, weno_num_stencils
3651 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3652 end do
3653 omega = alpha/sum(alpha)
3654 do q = 0, weno_num_stencils
3655 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
3656 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3657 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
3658 end do
3659 else if (wenoz) then
3660 do q = 0, weno_num_stencils
3661 alpha(q) = d_cbr_z(q, l)*(1._wp + tau/beta(q))
3662 end do
3663 end if
3664 omega = alpha/sum(alpha)
3665
3666 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3667 end do
3668 end do
3669 end do
3670 end do
3671
3672# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3673#if defined(MFC_OpenACC)
3674# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3675!$acc end parallel loop
3676# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3677#elif defined(MFC_OpenMP)
3678# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3679
3680# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3681!$omp end target teams loop
3682# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3683#endif
3684 end if
3685# 1063 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3686 end if
3687 if (weno_order == 5) then
3688# 1066 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3689# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3690# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3691# 1072 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3692 if (weno_dir == 1) then
3693
3694# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3695
3696# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3697#if defined(MFC_OpenACC)
3698# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3699!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3700# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3701#elif defined(MFC_OpenMP)
3702# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3703
3704# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3705
3706# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3707
3708# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3709!$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, vp0, vm1, vm2, vp1, vp2)
3710# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3711#endif
3712# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3713 do l = is3_weno%beg, is3_weno%end
3714 do k = is2_weno%beg, is2_weno%end
3715 do j = is1_weno%beg, is1_weno%end
3716
3717# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3718#if defined(MFC_OpenACC)
3719# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3720!$acc loop seq
3721# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3722#elif defined(MFC_OpenMP)
3723# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3724
3725# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3726#endif
3727 do i = 1, v_size
3728 ! reconstruct from left side
3729
3730 alpha(:) = 0._wp
3731
3732 vp0 = v_rs_weno(j, k, l, i)
3733 vm1 = v_rs_weno(j - 1, k, l, i)
3734 vm2 = v_rs_weno(j - 2, k, l, i)
3735 vp1 = v_rs_weno(j + 1, k, l, i)
3736 vp2 = v_rs_weno(j + 2, k, l, i)
3737
3738 dvd(1) = vp2 - vp1
3739 dvd(0) = vp1 - vp0
3740 dvd(-1) = vp0 - vm1
3741 dvd(-2) = vm1 - vm2
3742
3743 poly(0) = vp0 + poly_coef_cbl_x(j, 0, &
3744 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3745 poly(1) = vp0 + poly_coef_cbl_x(j, 1, &
3746 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3747 poly(2) = vp0 + poly_coef_cbl_x(j, 2, &
3748 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3749
3750 if (uniform_grid(1)) then
3751 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3752 & + weno_eps
3753 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3754 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3755 & + weno_eps
3756 else
3757 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
3758 & 0, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3759 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
3760 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, &
3761 & 2)*dvd(-1)*dvd(-1) + weno_eps
3762 beta(2) = beta_coef_x(j, 2, &
3763 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3764 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3765 end if
3766
3767 if (wenojs) then
3768 do q = 0, weno_num_stencils
3769 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3770 end do
3771 else if (mapped_weno) then
3772 do q = 0, weno_num_stencils
3773 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3774 end do
3775 omega = alpha/sum(alpha)
3776 do q = 0, weno_num_stencils
3777 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3778 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3779 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3780 end do
3781 else if (wenoz) then
3782 ! Borges, et al. (2008)
3783
3784 tau = abs(beta(2) - beta(0)) ! Equation 25
3785
3786# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3787#if defined(MFC_OpenACC)
3788# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3789!$acc loop seq
3790# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3791#elif defined(MFC_OpenMP)
3792# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3793
3794# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3795#endif
3796 do q = 0, weno_num_stencils
3797 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3798 ! Equation 28 (note: weno_eps was already added to beta)
3799 end do
3800 else if (teno) then
3801 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3802 tau = abs(beta(2) - beta(0))
3803
3804# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3805#if defined(MFC_OpenACC)
3806# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3807!$acc loop seq
3808# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3809#elif defined(MFC_OpenMP)
3810# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3811
3812# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3813#endif
3814 do q = 0, weno_num_stencils
3815 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3816 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3817 alpha(q) = (alpha(q)**3._wp)**2._wp
3818 end do
3819 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3820
3821
3822# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3823#if defined(MFC_OpenACC)
3824# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3825!$acc loop seq
3826# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3827#elif defined(MFC_OpenMP)
3828# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3829
3830# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3831#endif
3832 do q = 0, weno_num_stencils
3833 if (omega(q) < teno_ct) then ! Equation 26
3834 delta(q) = 0._wp
3835 else
3836 delta(q) = 1._wp
3837 end if
3838 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3839 end do
3840 end if
3841
3842 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3843 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3844 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3845
3846 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3847
3848 ! reconstruct from right side
3849
3850 poly(0) = vp0 + poly_coef_cbr_x(j, 0, &
3851 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3852 poly(1) = vp0 + poly_coef_cbr_x(j, 1, &
3853 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3854 poly(2) = vp0 + poly_coef_cbr_x(j, 2, &
3855 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3856
3857 if (wenojs) then
3858 do q = 0, weno_num_stencils
3859 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3860 end do
3861 else if (mapped_weno) then
3862 do q = 0, weno_num_stencils
3863 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3864 end do
3865 omega = alpha/sum(alpha)
3866 do q = 0, weno_num_stencils
3867 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3868 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3869 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3870 end do
3871 else if (wenoz) then
3872
3873# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3874#if defined(MFC_OpenACC)
3875# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3876!$acc loop seq
3877# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3878#elif defined(MFC_OpenMP)
3879# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3880
3881# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3882#endif
3883 do q = 0, weno_num_stencils
3884 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3885 end do
3886 else if (teno) then
3887
3888# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3889#if defined(MFC_OpenACC)
3890# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3891!$acc loop seq
3892# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3893#elif defined(MFC_OpenMP)
3894# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3895
3896# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3897#endif
3898 do q = 0, weno_num_stencils
3899 alpha(q) = delta(q)*d_cbr_x(q, j)
3900 end do
3901 end if
3902
3903 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3904 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3905 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3906
3907 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3908 end do
3909 end do
3910 end do
3911 end do
3912
3913# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3914#if defined(MFC_OpenACC)
3915# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916!$acc end parallel loop
3917# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3918#elif defined(MFC_OpenMP)
3919# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3920
3921# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3922!$omp end target teams loop
3923# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3924#endif
3925
3926 if (mp_weno) then
3927 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
3928 end if
3929 end if
3930# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3931# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3932# 1072 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3933 if (weno_dir == 2) then
3934
3935# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3936
3937# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3938#if defined(MFC_OpenACC)
3939# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3940!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3941# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3942#elif defined(MFC_OpenMP)
3943# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3944
3945# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3946
3947# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3948
3949# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3950!$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, vp0, vm1, vm2, vp1, vp2)
3951# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3952#endif
3953# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3954 do l = is3_weno%beg, is3_weno%end
3955 do k = is1_weno%beg, is1_weno%end
3956 do j = is2_weno%beg, is2_weno%end
3957
3958# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3959#if defined(MFC_OpenACC)
3960# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3961!$acc loop seq
3962# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3963#elif defined(MFC_OpenMP)
3964# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3965
3966# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3967#endif
3968 do i = 1, v_size
3969 ! reconstruct from left side
3970
3971 alpha(:) = 0._wp
3972
3973 vp0 = v_rs_weno(j, k, l, i)
3974 vm1 = v_rs_weno(j, k - 1, l, i)
3975 vm2 = v_rs_weno(j, k - 2, l, i)
3976 vp1 = v_rs_weno(j, k + 1, l, i)
3977 vp2 = v_rs_weno(j, k + 2, l, i)
3978
3979 dvd(1) = vp2 - vp1
3980 dvd(0) = vp1 - vp0
3981 dvd(-1) = vp0 - vm1
3982 dvd(-2) = vm1 - vm2
3983
3984 poly(0) = vp0 + poly_coef_cbl_y(k, 0, &
3985 & 0)*dvd(1) + poly_coef_cbl_y(k, 0, 1)*dvd(0)
3986 poly(1) = vp0 + poly_coef_cbl_y(k, 1, &
3987 & 0)*dvd(0) + poly_coef_cbl_y(k, 1, 1)*dvd(-1)
3988 poly(2) = vp0 + poly_coef_cbl_y(k, 2, &
3989 & 0)*dvd(-1) + poly_coef_cbl_y(k, 2, 1)*dvd(-2)
3990
3991 if (uniform_grid(2)) then
3992 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3993 & + weno_eps
3994 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3995 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3996 & + weno_eps
3997 else
3998 beta(0) = beta_coef_y(k, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
3999 & 0, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 2)*dvd(0)*dvd(0) + weno_eps
4000 beta(1) = beta_coef_y(k, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4001 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, &
4002 & 2)*dvd(-1)*dvd(-1) + weno_eps
4003 beta(2) = beta_coef_y(k, 2, &
4004 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4005 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4006 end if
4007
4008 if (wenojs) then
4009 do q = 0, weno_num_stencils
4010 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4011 end do
4012 else if (mapped_weno) then
4013 do q = 0, weno_num_stencils
4014 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4015 end do
4016 omega = alpha/sum(alpha)
4017 do q = 0, weno_num_stencils
4018 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4019 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4020 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4021 end do
4022 else if (wenoz) then
4023 ! Borges, et al. (2008)
4024
4025 tau = abs(beta(2) - beta(0)) ! Equation 25
4026
4027# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4028#if defined(MFC_OpenACC)
4029# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4030!$acc loop seq
4031# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4032#elif defined(MFC_OpenMP)
4033# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4034
4035# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4036#endif
4037 do q = 0, weno_num_stencils
4038 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q)))
4039 ! Equation 28 (note: weno_eps was already added to beta)
4040 end do
4041 else if (teno) then
4042 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4043 tau = abs(beta(2) - beta(0))
4044
4045# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4046#if defined(MFC_OpenACC)
4047# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4048!$acc loop seq
4049# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4050#elif defined(MFC_OpenMP)
4051# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4052
4053# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4054#endif
4055 do q = 0, weno_num_stencils
4056 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4057 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4058 alpha(q) = (alpha(q)**3._wp)**2._wp
4059 end do
4060 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4061
4062
4063# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4064#if defined(MFC_OpenACC)
4065# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4066!$acc loop seq
4067# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4068#elif defined(MFC_OpenMP)
4069# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4070
4071# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4072#endif
4073 do q = 0, weno_num_stencils
4074 if (omega(q) < teno_ct) then ! Equation 26
4075 delta(q) = 0._wp
4076 else
4077 delta(q) = 1._wp
4078 end if
4079 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4080 end do
4081 end if
4082
4083 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4084 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4085 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4086
4087 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4088
4089 ! reconstruct from right side
4090
4091 poly(0) = vp0 + poly_coef_cbr_y(k, 0, &
4092 & 0)*dvd(1) + poly_coef_cbr_y(k, 0, 1)*dvd(0)
4093 poly(1) = vp0 + poly_coef_cbr_y(k, 1, &
4094 & 0)*dvd(0) + poly_coef_cbr_y(k, 1, 1)*dvd(-1)
4095 poly(2) = vp0 + poly_coef_cbr_y(k, 2, &
4096 & 0)*dvd(-1) + poly_coef_cbr_y(k, 2, 1)*dvd(-2)
4097
4098 if (wenojs) then
4099 do q = 0, weno_num_stencils
4100 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4101 end do
4102 else if (mapped_weno) then
4103 do q = 0, weno_num_stencils
4104 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4105 end do
4106 omega = alpha/sum(alpha)
4107 do q = 0, weno_num_stencils
4108 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4109 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4110 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4111 end do
4112 else if (wenoz) then
4113
4114# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4115#if defined(MFC_OpenACC)
4116# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4117!$acc loop seq
4118# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4119#elif defined(MFC_OpenMP)
4120# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4121
4122# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4123#endif
4124 do q = 0, weno_num_stencils
4125 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q)))
4126 end do
4127 else if (teno) then
4128
4129# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4130#if defined(MFC_OpenACC)
4131# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4132!$acc loop seq
4133# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4134#elif defined(MFC_OpenMP)
4135# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4136
4137# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4138#endif
4139 do q = 0, weno_num_stencils
4140 alpha(q) = delta(q)*d_cbr_y(q, k)
4141 end do
4142 end if
4143
4144 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4145 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4146 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4147
4148 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4149 end do
4150 end do
4151 end do
4152 end do
4153
4154# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4155#if defined(MFC_OpenACC)
4156# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4157!$acc end parallel loop
4158# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4159#elif defined(MFC_OpenMP)
4160# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4161
4162# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4163!$omp end target teams loop
4164# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4165#endif
4166
4167 if (mp_weno) then
4168 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4169 end if
4170 end if
4171# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4172# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4173# 1072 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4174 if (weno_dir == 3) then
4175
4176# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4177
4178# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4179#if defined(MFC_OpenACC)
4180# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4181!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4182# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4183#elif defined(MFC_OpenMP)
4184# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4185
4186# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4187
4188# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4189
4190# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4191!$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, vp0, vm1, vm2, vp1, vp2)
4192# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4193#endif
4194# 1075 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4195 do l = is1_weno%beg, is1_weno%end
4196 do k = is2_weno%beg, is2_weno%end
4197 do j = is3_weno%beg, is3_weno%end
4198
4199# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4200#if defined(MFC_OpenACC)
4201# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4202!$acc loop seq
4203# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4204#elif defined(MFC_OpenMP)
4205# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4206
4207# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4208#endif
4209 do i = 1, v_size
4210 ! reconstruct from left side
4211
4212 alpha(:) = 0._wp
4213
4214 vp0 = v_rs_weno(j, k, l, i)
4215 vm1 = v_rs_weno(j, k, l - 1, i)
4216 vm2 = v_rs_weno(j, k, l - 2, i)
4217 vp1 = v_rs_weno(j, k, l + 1, i)
4218 vp2 = v_rs_weno(j, k, l + 2, i)
4219
4220 dvd(1) = vp2 - vp1
4221 dvd(0) = vp1 - vp0
4222 dvd(-1) = vp0 - vm1
4223 dvd(-2) = vm1 - vm2
4224
4225 poly(0) = vp0 + poly_coef_cbl_z(l, 0, &
4226 & 0)*dvd(1) + poly_coef_cbl_z(l, 0, 1)*dvd(0)
4227 poly(1) = vp0 + poly_coef_cbl_z(l, 1, &
4228 & 0)*dvd(0) + poly_coef_cbl_z(l, 1, 1)*dvd(-1)
4229 poly(2) = vp0 + poly_coef_cbl_z(l, 2, &
4230 & 0)*dvd(-1) + poly_coef_cbl_z(l, 2, 1)*dvd(-2)
4231
4232 if (uniform_grid(3)) then
4233 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4234 & + weno_eps
4235 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4236 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4237 & + weno_eps
4238 else
4239 beta(0) = beta_coef_z(l, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
4240 & 0, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 2)*dvd(0)*dvd(0) + weno_eps
4241 beta(1) = beta_coef_z(l, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
4242 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, &
4243 & 2)*dvd(-1)*dvd(-1) + weno_eps
4244 beta(2) = beta_coef_z(l, 2, &
4245 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
4246 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4247 end if
4248
4249 if (wenojs) then
4250 do q = 0, weno_num_stencils
4251 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4252 end do
4253 else if (mapped_weno) then
4254 do q = 0, weno_num_stencils
4255 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4256 end do
4257 omega = alpha/sum(alpha)
4258 do q = 0, weno_num_stencils
4259 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
4260 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4261 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
4262 end do
4263 else if (wenoz) then
4264 ! Borges, et al. (2008)
4265
4266 tau = abs(beta(2) - beta(0)) ! Equation 25
4267
4268# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4269#if defined(MFC_OpenACC)
4270# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4271!$acc loop seq
4272# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4273#elif defined(MFC_OpenMP)
4274# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4275
4276# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4277#endif
4278 do q = 0, weno_num_stencils
4279 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q)))
4280 ! Equation 28 (note: weno_eps was already added to beta)
4281 end do
4282 else if (teno) then
4283 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4284 tau = abs(beta(2) - beta(0))
4285
4286# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4287#if defined(MFC_OpenACC)
4288# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4289!$acc loop seq
4290# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4291#elif defined(MFC_OpenMP)
4292# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4293
4294# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4295#endif
4296 do q = 0, weno_num_stencils
4297 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4298 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4299 alpha(q) = (alpha(q)**3._wp)**2._wp
4300 end do
4301 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4302
4303
4304# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4305#if defined(MFC_OpenACC)
4306# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4307!$acc loop seq
4308# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4309#elif defined(MFC_OpenMP)
4310# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4311
4312# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4313#endif
4314 do q = 0, weno_num_stencils
4315 if (omega(q) < teno_ct) then ! Equation 26
4316 delta(q) = 0._wp
4317 else
4318 delta(q) = 1._wp
4319 end if
4320 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
4321 end do
4322 end if
4323
4324 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4325 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4326 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4327
4328 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4329
4330 ! reconstruct from right side
4331
4332 poly(0) = vp0 + poly_coef_cbr_z(l, 0, &
4333 & 0)*dvd(1) + poly_coef_cbr_z(l, 0, 1)*dvd(0)
4334 poly(1) = vp0 + poly_coef_cbr_z(l, 1, &
4335 & 0)*dvd(0) + poly_coef_cbr_z(l, 1, 1)*dvd(-1)
4336 poly(2) = vp0 + poly_coef_cbr_z(l, 2, &
4337 & 0)*dvd(-1) + poly_coef_cbr_z(l, 2, 1)*dvd(-2)
4338
4339 if (wenojs) then
4340 do q = 0, weno_num_stencils
4341 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4342 end do
4343 else if (mapped_weno) then
4344 do q = 0, weno_num_stencils
4345 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4346 end do
4347 omega = alpha/sum(alpha)
4348 do q = 0, weno_num_stencils
4349 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
4350 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4351 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
4352 end do
4353 else if (wenoz) then
4354
4355# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4356#if defined(MFC_OpenACC)
4357# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4358!$acc loop seq
4359# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4360#elif defined(MFC_OpenMP)
4361# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4362
4363# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4364#endif
4365 do q = 0, weno_num_stencils
4366 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q)))
4367 end do
4368 else if (teno) then
4369
4370# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4371#if defined(MFC_OpenACC)
4372# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4373!$acc loop seq
4374# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4375#elif defined(MFC_OpenMP)
4376# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4377
4378# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4379#endif
4380 do q = 0, weno_num_stencils
4381 alpha(q) = delta(q)*d_cbr_z(q, l)
4382 end do
4383 end if
4384
4385 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4386 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4387 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4388
4389 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4390 end do
4391 end do
4392 end do
4393 end do
4394
4395# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4396#if defined(MFC_OpenACC)
4397# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4398!$acc end parallel loop
4399# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4400#elif defined(MFC_OpenMP)
4401# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4402
4403# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4404!$omp end target teams loop
4405# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4406#endif
4407
4408 if (mp_weno) then
4409 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4410 end if
4411 end if
4412# 1221 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4413# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4414 end if
4415 if (weno_order == 7) then
4416# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4417# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4418# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4419# 1231 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4420 if (weno_dir == 1) then
4421
4422# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4423
4424# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4425#if defined(MFC_OpenACC)
4426# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4427!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4428# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4429#elif defined(MFC_OpenMP)
4430# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4431
4432# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4433
4434# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4435
4436# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4437!$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, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4438# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4439#endif
4440# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4441 do l = is3_weno%beg, is3_weno%end
4442 do k = is2_weno%beg, is2_weno%end
4443 do j = is1_weno%beg, is1_weno%end
4444
4445# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4446#if defined(MFC_OpenACC)
4447# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4448!$acc loop seq
4449# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4450#elif defined(MFC_OpenMP)
4451# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4452
4453# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4454#endif
4455 do i = 1, v_size
4456 alpha(:) = 0._wp
4457
4458 vp0 = v_rs_weno(j, k, l, i)
4459 vm1 = v_rs_weno(j - 1, k, l, i)
4460 vm2 = v_rs_weno(j - 2, k, l, i)
4461 vm3 = v_rs_weno(j - 3, k, l, i)
4462 vp1 = v_rs_weno(j + 1, k, l, i)
4463 vp2 = v_rs_weno(j + 2, k, l, i)
4464 vp3 = v_rs_weno(j + 3, k, l, i)
4465
4466 if (teno) then
4467 v(-3) = vm3
4468 v(-2) = vm2
4469 v(-1) = vm1
4470 v(0) = vp0
4471 v(1) = vp1
4472 v(2) = vp2
4473 v(3) = vp3
4474 end if
4475
4476 if (.not. teno) then
4477 dvd(2) = vp3 - vp2
4478 dvd(1) = vp2 - vp1
4479 dvd(0) = vp1 - vp0
4480 dvd(-1) = vp0 - vm1
4481 dvd(-2) = vm1 - vm2
4482 dvd(-3) = vm2 - vm3
4483
4484 poly(3) = vp0 + poly_coef_cbl_x(j, 0, &
4485 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, &
4486 & 1)*dvd(1) + poly_coef_cbl_x(j, 0, 2)*dvd(0)
4487 poly(2) = vp0 + poly_coef_cbl_x(j, 1, &
4488 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, &
4489 & 1)*dvd(0) + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
4490 poly(1) = vp0 + poly_coef_cbl_x(j, 2, &
4491 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4492 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4493 poly(0) = vp0 + poly_coef_cbl_x(j, 3, &
4494 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4495 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4496 else
4497# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4498 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4499 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4500 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4501 ! to keep the stencil order to reuse the beta coefficients
4502 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4503 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4504 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4505 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4506 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4507# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4508 end if
4509
4510 if (.not. teno) then
4511 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, &
4512 & 0, 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4513 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4514 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4515 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4516
4517 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
4518 & 1, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4519 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4520 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4521 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4522
4523 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
4524 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4525 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4526 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4527 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4528
4529 beta(0) = beta_coef_x(j, 3, &
4530 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4531 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4532 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4533 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4534 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4535 else
4536# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4537 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4538 ! & Tang, 2019) Section 3.2
4539 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4540 & **2._wp)/4._wp + weno_eps
4541 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4542 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4543 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4544 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4545
4546 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4547 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4548 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4549
4550 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4551 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4552 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4553# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4554 end if
4555
4556 if (wenojs) then
4557 do q = 0, weno_num_stencils
4558 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4559 end do
4560 else if (mapped_weno) then
4561 do q = 0, weno_num_stencils
4562 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4563 end do
4564 omega = alpha/sum(alpha)
4565 do q = 0, weno_num_stencils
4566 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4567 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4568 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4569 end do
4570 else if (wenoz) then
4571 ! Castro, et al. (2010) Don & Borges (2013) also helps
4572 tau = abs(beta(3) - beta(0)) ! Equation 50
4573
4574# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4575#if defined(MFC_OpenACC)
4576# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4577!$acc loop seq
4578# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4579#elif defined(MFC_OpenMP)
4580# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4581
4582# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4583#endif
4584 do q = 0, weno_num_stencils
4585 ! wenoz_q = 2,3,4 for stability
4586 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4587 end do
4588 else if (teno) then
4589# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4590 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4591 alpha = 1._wp + tau/beta
4592 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4593 omega = alpha/sum(alpha)
4594
4595
4596# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4597#if defined(MFC_OpenACC)
4598# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4599!$acc loop seq
4600# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4601#elif defined(MFC_OpenMP)
4602# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4603
4604# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4605#endif
4606 do q = 0, weno_num_stencils
4607 if (omega(q) < teno_ct) then ! Equation 26
4608 delta(q) = 0._wp
4609 else
4610 delta(q) = 1._wp
4611 end if
4612 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4613 end do
4614# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4615 end if
4616
4617 omega = alpha/sum(alpha)
4618
4619 vl_rs_vf_x(j, k, l, &
4620 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4621
4622 if (teno) then
4623# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4624 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4625# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4626 end if
4627
4628 if (.not. teno) then
4629 poly(3) = vp0 + poly_coef_cbr_x(j, 0, &
4630 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, &
4631 & 1)*dvd(1) + poly_coef_cbr_x(j, 0, 2)*dvd(0)
4632 poly(2) = vp0 + poly_coef_cbr_x(j, 1, &
4633 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, &
4634 & 1)*dvd(0) + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
4635 poly(1) = vp0 + poly_coef_cbr_x(j, 2, &
4636 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4637 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4638 poly(0) = vp0 + poly_coef_cbr_x(j, 3, &
4639 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4640 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4641 else
4642# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4643 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4644 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4645 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4646 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4647 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4648# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4649 end if
4650
4651 if (wenojs) then
4652 do q = 0, weno_num_stencils
4653 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4654 end do
4655 else if (mapped_weno) then
4656 do q = 0, weno_num_stencils
4657 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4658 end do
4659 omega = alpha/sum(alpha)
4660 do q = 0, weno_num_stencils
4661 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4662 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4663 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4664 end do
4665 else if (wenoz) then
4666
4667# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4668#if defined(MFC_OpenACC)
4669# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4670!$acc loop seq
4671# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4672#elif defined(MFC_OpenMP)
4673# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4674
4675# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4676#endif
4677 do q = 0, weno_num_stencils
4678 ! wenoz_q = 2,3,4 for stability
4679 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4680 end do
4681 else if (teno) then
4682
4683# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4684#if defined(MFC_OpenACC)
4685# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4686!$acc loop seq
4687# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4688#elif defined(MFC_OpenMP)
4689# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4690
4691# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4692#endif
4693 do q = 0, weno_num_stencils
4694 alpha(q) = delta(q)*d_cbr_x(q, j)
4695 end do
4696 end if
4697
4698 omega = alpha/sum(alpha)
4699
4700 vr_rs_vf_x(j, k, l, &
4701 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4702
4703 if (teno) then
4704# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4705 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4706# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4707 end if
4708 end do
4709 end do
4710 end do
4711 end do
4712
4713# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4714#if defined(MFC_OpenACC)
4715# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4716!$acc end parallel loop
4717# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4718#elif defined(MFC_OpenMP)
4719# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4720
4721# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4722!$omp end target teams loop
4723# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4724#endif
4725 end if
4726# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4727# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4728# 1231 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4729 if (weno_dir == 2) then
4730
4731# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4732
4733# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4734#if defined(MFC_OpenACC)
4735# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4736!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4737# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4738#elif defined(MFC_OpenMP)
4739# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4740
4741# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4742
4743# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4744
4745# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4746!$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, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4747# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4748#endif
4749# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4750 do l = is3_weno%beg, is3_weno%end
4751 do k = is1_weno%beg, is1_weno%end
4752 do j = is2_weno%beg, is2_weno%end
4753
4754# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4755#if defined(MFC_OpenACC)
4756# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4757!$acc loop seq
4758# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4759#elif defined(MFC_OpenMP)
4760# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4761
4762# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4763#endif
4764 do i = 1, v_size
4765 alpha(:) = 0._wp
4766
4767 vp0 = v_rs_weno(j, k, l, i)
4768 vm1 = v_rs_weno(j, k - 1, l, i)
4769 vm2 = v_rs_weno(j, k - 2, l, i)
4770 vm3 = v_rs_weno(j, k - 3, l, i)
4771 vp1 = v_rs_weno(j, k + 1, l, i)
4772 vp2 = v_rs_weno(j, k + 2, l, i)
4773 vp3 = v_rs_weno(j, k + 3, l, i)
4774
4775 if (teno) then
4776 v(-3) = vm3
4777 v(-2) = vm2
4778 v(-1) = vm1
4779 v(0) = vp0
4780 v(1) = vp1
4781 v(2) = vp2
4782 v(3) = vp3
4783 end if
4784
4785 if (.not. teno) then
4786 dvd(2) = vp3 - vp2
4787 dvd(1) = vp2 - vp1
4788 dvd(0) = vp1 - vp0
4789 dvd(-1) = vp0 - vm1
4790 dvd(-2) = vm1 - vm2
4791 dvd(-3) = vm2 - vm3
4792
4793 poly(3) = vp0 + poly_coef_cbl_y(k, 0, &
4794 & 0)*dvd(2) + poly_coef_cbl_y(k, 0, &
4795 & 1)*dvd(1) + poly_coef_cbl_y(k, 0, 2)*dvd(0)
4796 poly(2) = vp0 + poly_coef_cbl_y(k, 1, &
4797 & 0)*dvd(1) + poly_coef_cbl_y(k, 1, &
4798 & 1)*dvd(0) + poly_coef_cbl_y(k, 1, 2)*dvd(-1)
4799 poly(1) = vp0 + poly_coef_cbl_y(k, 2, &
4800 & 0)*dvd(0) + poly_coef_cbl_y(k, 2, &
4801 & 1)*dvd(-1) + poly_coef_cbl_y(k, 2, 2)*dvd(-2)
4802 poly(0) = vp0 + poly_coef_cbl_y(k, 3, &
4803 & 0)*dvd(-1) + poly_coef_cbl_y(k, 3, &
4804 & 1)*dvd(-2) + poly_coef_cbl_y(k, 3, 2)*dvd(-3)
4805 else
4806# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4807 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4808 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4809 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4810 ! to keep the stencil order to reuse the beta coefficients
4811 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4812 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4813 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4814 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4815 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4816# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4817 end if
4818
4819 if (.not. teno) then
4820 beta(3) = beta_coef_y(k, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(k, &
4821 & 0, 1)*dvd(2)*dvd(1) + beta_coef_y(k, 0, &
4822 & 2)*dvd(2)*dvd(0) + beta_coef_y(k, 0, &
4823 & 3)*dvd(1)*dvd(1) + beta_coef_y(k, 0, &
4824 & 4)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 5)*dvd(0)*dvd(0) + weno_eps
4825
4826 beta(2) = beta_coef_y(k, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4827 & 1, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 1, &
4828 & 2)*dvd(1)*dvd(-1) + beta_coef_y(k, 1, &
4829 & 3)*dvd(0)*dvd(0) + beta_coef_y(k, 1, &
4830 & 4)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4831
4832 beta(1) = beta_coef_y(k, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4833 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 2, &
4834 & 2)*dvd(0)*dvd(-2) + beta_coef_y(k, 2, &
4835 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4836 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4837
4838 beta(0) = beta_coef_y(k, 3, &
4839 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 3, &
4840 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 3, &
4841 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(k, 3, &
4842 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(k, 3, &
4843 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(k, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4844 else
4845# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4846 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4847 ! & Tang, 2019) Section 3.2
4848 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4849 & **2._wp)/4._wp + weno_eps
4850 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4851 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4852 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4853 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4854
4855 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4856 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4857 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4858
4859 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4860 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4861 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4862# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4863 end if
4864
4865 if (wenojs) then
4866 do q = 0, weno_num_stencils
4867 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4868 end do
4869 else if (mapped_weno) then
4870 do q = 0, weno_num_stencils
4871 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4872 end do
4873 omega = alpha/sum(alpha)
4874 do q = 0, weno_num_stencils
4875 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4876 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4877 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4878 end do
4879 else if (wenoz) then
4880 ! Castro, et al. (2010) Don & Borges (2013) also helps
4881 tau = abs(beta(3) - beta(0)) ! Equation 50
4882
4883# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4884#if defined(MFC_OpenACC)
4885# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4886!$acc loop seq
4887# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4888#elif defined(MFC_OpenMP)
4889# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4890
4891# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4892#endif
4893 do q = 0, weno_num_stencils
4894 ! wenoz_q = 2,3,4 for stability
4895 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
4896 end do
4897 else if (teno) then
4898# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4899 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4900 alpha = 1._wp + tau/beta
4901 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4902 omega = alpha/sum(alpha)
4903
4904
4905# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4906#if defined(MFC_OpenACC)
4907# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4908!$acc loop seq
4909# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4910#elif defined(MFC_OpenMP)
4911# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4912
4913# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4914#endif
4915 do q = 0, weno_num_stencils
4916 if (omega(q) < teno_ct) then ! Equation 26
4917 delta(q) = 0._wp
4918 else
4919 delta(q) = 1._wp
4920 end if
4921 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4922 end do
4923# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4924 end if
4925
4926 omega = alpha/sum(alpha)
4927
4928 vl_rs_vf_x(j, k, l, &
4929 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4930
4931 if (teno) then
4932# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4933 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4934# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4935 end if
4936
4937 if (.not. teno) then
4938 poly(3) = vp0 + poly_coef_cbr_y(k, 0, &
4939 & 0)*dvd(2) + poly_coef_cbr_y(k, 0, &
4940 & 1)*dvd(1) + poly_coef_cbr_y(k, 0, 2)*dvd(0)
4941 poly(2) = vp0 + poly_coef_cbr_y(k, 1, &
4942 & 0)*dvd(1) + poly_coef_cbr_y(k, 1, &
4943 & 1)*dvd(0) + poly_coef_cbr_y(k, 1, 2)*dvd(-1)
4944 poly(1) = vp0 + poly_coef_cbr_y(k, 2, &
4945 & 0)*dvd(0) + poly_coef_cbr_y(k, 2, &
4946 & 1)*dvd(-1) + poly_coef_cbr_y(k, 2, 2)*dvd(-2)
4947 poly(0) = vp0 + poly_coef_cbr_y(k, 3, &
4948 & 0)*dvd(-1) + poly_coef_cbr_y(k, 3, &
4949 & 1)*dvd(-2) + poly_coef_cbr_y(k, 3, 2)*dvd(-3)
4950 else
4951# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4952 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4953 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4954 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4955 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4956 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4957# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4958 end if
4959
4960 if (wenojs) then
4961 do q = 0, weno_num_stencils
4962 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4963 end do
4964 else if (mapped_weno) then
4965 do q = 0, weno_num_stencils
4966 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4967 end do
4968 omega = alpha/sum(alpha)
4969 do q = 0, weno_num_stencils
4970 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4971 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4972 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4973 end do
4974 else if (wenoz) then
4975
4976# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4977#if defined(MFC_OpenACC)
4978# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4979!$acc loop seq
4980# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4981#elif defined(MFC_OpenMP)
4982# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4983
4984# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4985#endif
4986 do q = 0, weno_num_stencils
4987 ! wenoz_q = 2,3,4 for stability
4988 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
4989 end do
4990 else if (teno) then
4991
4992# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4993#if defined(MFC_OpenACC)
4994# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4995!$acc loop seq
4996# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4997#elif defined(MFC_OpenMP)
4998# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4999
5000# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5001#endif
5002 do q = 0, weno_num_stencils
5003 alpha(q) = delta(q)*d_cbr_y(q, k)
5004 end do
5005 end if
5006
5007 omega = alpha/sum(alpha)
5008
5009 vr_rs_vf_x(j, k, l, &
5010 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5011
5012 if (teno) then
5013# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5014 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5015# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5016 end if
5017 end do
5018 end do
5019 end do
5020 end do
5021
5022# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5023#if defined(MFC_OpenACC)
5024# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5025!$acc end parallel loop
5026# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5027#elif defined(MFC_OpenMP)
5028# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5029
5030# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5031!$omp end target teams loop
5032# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5033#endif
5034 end if
5035# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5036# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5037# 1231 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5038 if (weno_dir == 3) then
5039
5040# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5041
5042# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5043#if defined(MFC_OpenACC)
5044# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5045!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5046# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5047#elif defined(MFC_OpenMP)
5048# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5049
5050# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5051
5052# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5053
5054# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5055!$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, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5056# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5057#endif
5058# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5059 do l = is1_weno%beg, is1_weno%end
5060 do k = is2_weno%beg, is2_weno%end
5061 do j = is3_weno%beg, is3_weno%end
5062
5063# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5064#if defined(MFC_OpenACC)
5065# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5066!$acc loop seq
5067# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5068#elif defined(MFC_OpenMP)
5069# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5070
5071# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5072#endif
5073 do i = 1, v_size
5074 alpha(:) = 0._wp
5075
5076 vp0 = v_rs_weno(j, k, l, i)
5077 vm1 = v_rs_weno(j, k, l - 1, i)
5078 vm2 = v_rs_weno(j, k, l - 2, i)
5079 vm3 = v_rs_weno(j, k, l - 3, i)
5080 vp1 = v_rs_weno(j, k, l + 1, i)
5081 vp2 = v_rs_weno(j, k, l + 2, i)
5082 vp3 = v_rs_weno(j, k, l + 3, i)
5083
5084 if (teno) then
5085 v(-3) = vm3
5086 v(-2) = vm2
5087 v(-1) = vm1
5088 v(0) = vp0
5089 v(1) = vp1
5090 v(2) = vp2
5091 v(3) = vp3
5092 end if
5093
5094 if (.not. teno) then
5095 dvd(2) = vp3 - vp2
5096 dvd(1) = vp2 - vp1
5097 dvd(0) = vp1 - vp0
5098 dvd(-1) = vp0 - vm1
5099 dvd(-2) = vm1 - vm2
5100 dvd(-3) = vm2 - vm3
5101
5102 poly(3) = vp0 + poly_coef_cbl_z(l, 0, &
5103 & 0)*dvd(2) + poly_coef_cbl_z(l, 0, &
5104 & 1)*dvd(1) + poly_coef_cbl_z(l, 0, 2)*dvd(0)
5105 poly(2) = vp0 + poly_coef_cbl_z(l, 1, &
5106 & 0)*dvd(1) + poly_coef_cbl_z(l, 1, &
5107 & 1)*dvd(0) + poly_coef_cbl_z(l, 1, 2)*dvd(-1)
5108 poly(1) = vp0 + poly_coef_cbl_z(l, 2, &
5109 & 0)*dvd(0) + poly_coef_cbl_z(l, 2, &
5110 & 1)*dvd(-1) + poly_coef_cbl_z(l, 2, 2)*dvd(-2)
5111 poly(0) = vp0 + poly_coef_cbl_z(l, 3, &
5112 & 0)*dvd(-1) + poly_coef_cbl_z(l, 3, &
5113 & 1)*dvd(-2) + poly_coef_cbl_z(l, 3, 2)*dvd(-3)
5114 else
5115# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5116 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5117 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5118 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5119 ! to keep the stencil order to reuse the beta coefficients
5120 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5121 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5122 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5123 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5124 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5125# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126 end if
5127
5128 if (.not. teno) then
5129 beta(3) = beta_coef_z(l, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(l, &
5130 & 0, 1)*dvd(2)*dvd(1) + beta_coef_z(l, 0, &
5131 & 2)*dvd(2)*dvd(0) + beta_coef_z(l, 0, &
5132 & 3)*dvd(1)*dvd(1) + beta_coef_z(l, 0, &
5133 & 4)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 5)*dvd(0)*dvd(0) + weno_eps
5134
5135 beta(2) = beta_coef_z(l, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
5136 & 1, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 1, &
5137 & 2)*dvd(1)*dvd(-1) + beta_coef_z(l, 1, &
5138 & 3)*dvd(0)*dvd(0) + beta_coef_z(l, 1, &
5139 & 4)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5140
5141 beta(1) = beta_coef_z(l, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
5142 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 2, &
5143 & 2)*dvd(0)*dvd(-2) + beta_coef_z(l, 2, &
5144 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
5145 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5146
5147 beta(0) = beta_coef_z(l, 3, &
5148 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 3, &
5149 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 3, &
5150 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(l, 3, &
5151 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(l, 3, &
5152 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(l, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5153 else
5154# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5155 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5156 ! & Tang, 2019) Section 3.2
5157 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5158 & **2._wp)/4._wp + weno_eps
5159 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5160 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5161 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5162 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5163
5164 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5165 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5166 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5167
5168 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5169 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5170 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5171# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5172 end if
5173
5174 if (wenojs) then
5175 do q = 0, weno_num_stencils
5176 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5177 end do
5178 else if (mapped_weno) then
5179 do q = 0, weno_num_stencils
5180 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5181 end do
5182 omega = alpha/sum(alpha)
5183 do q = 0, weno_num_stencils
5184 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
5185 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5186 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
5187 end do
5188 else if (wenoz) then
5189 ! Castro, et al. (2010) Don & Borges (2013) also helps
5190 tau = abs(beta(3) - beta(0)) ! Equation 50
5191
5192# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5193#if defined(MFC_OpenACC)
5194# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5195!$acc loop seq
5196# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5197#elif defined(MFC_OpenMP)
5198# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5199
5200# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5201#endif
5202 do q = 0, weno_num_stencils
5203 ! wenoz_q = 2,3,4 for stability
5204 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5205 end do
5206 else if (teno) then
5207# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5208 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5209 alpha = 1._wp + tau/beta
5210 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5211 omega = alpha/sum(alpha)
5212
5213
5214# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5215#if defined(MFC_OpenACC)
5216# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217!$acc loop seq
5218# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219#elif defined(MFC_OpenMP)
5220# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221
5222# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223#endif
5224 do q = 0, weno_num_stencils
5225 if (omega(q) < teno_ct) then ! Equation 26
5226 delta(q) = 0._wp
5227 else
5228 delta(q) = 1._wp
5229 end if
5230 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
5231 end do
5232# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5233 end if
5234
5235 omega = alpha/sum(alpha)
5236
5237 vl_rs_vf_x(j, k, l, &
5238 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5239
5240 if (teno) then
5241# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5242 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5243# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5244 end if
5245
5246 if (.not. teno) then
5247 poly(3) = vp0 + poly_coef_cbr_z(l, 0, &
5248 & 0)*dvd(2) + poly_coef_cbr_z(l, 0, &
5249 & 1)*dvd(1) + poly_coef_cbr_z(l, 0, 2)*dvd(0)
5250 poly(2) = vp0 + poly_coef_cbr_z(l, 1, &
5251 & 0)*dvd(1) + poly_coef_cbr_z(l, 1, &
5252 & 1)*dvd(0) + poly_coef_cbr_z(l, 1, 2)*dvd(-1)
5253 poly(1) = vp0 + poly_coef_cbr_z(l, 2, &
5254 & 0)*dvd(0) + poly_coef_cbr_z(l, 2, &
5255 & 1)*dvd(-1) + poly_coef_cbr_z(l, 2, 2)*dvd(-2)
5256 poly(0) = vp0 + poly_coef_cbr_z(l, 3, &
5257 & 0)*dvd(-1) + poly_coef_cbr_z(l, 3, &
5258 & 1)*dvd(-2) + poly_coef_cbr_z(l, 3, 2)*dvd(-3)
5259 else
5260# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5261 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5262 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5263 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5264 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5265 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5266# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5267 end if
5268
5269 if (wenojs) then
5270 do q = 0, weno_num_stencils
5271 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5272 end do
5273 else if (mapped_weno) then
5274 do q = 0, weno_num_stencils
5275 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5276 end do
5277 omega = alpha/sum(alpha)
5278 do q = 0, weno_num_stencils
5279 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
5280 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5281 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
5282 end do
5283 else if (wenoz) then
5284
5285# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5286#if defined(MFC_OpenACC)
5287# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5288!$acc loop seq
5289# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5290#elif defined(MFC_OpenMP)
5291# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5292
5293# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5294#endif
5295 do q = 0, weno_num_stencils
5296 ! wenoz_q = 2,3,4 for stability
5297 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5298 end do
5299 else if (teno) then
5300
5301# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5302#if defined(MFC_OpenACC)
5303# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5304!$acc loop seq
5305# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5306#elif defined(MFC_OpenMP)
5307# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5308
5309# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5310#endif
5311 do q = 0, weno_num_stencils
5312 alpha(q) = delta(q)*d_cbr_z(q, l)
5313 end do
5314 end if
5315
5316 omega = alpha/sum(alpha)
5317
5318 vr_rs_vf_x(j, k, l, &
5319 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5320
5321 if (teno) then
5322# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5323 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5324# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5325 end if
5326 end do
5327 end do
5328 end do
5329 end do
5330
5331# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5332#if defined(MFC_OpenACC)
5333# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5334!$acc end parallel loop
5335# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5336#elif defined(MFC_OpenMP)
5337# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5338
5339# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5340!$omp end target teams loop
5341# 1455 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5342#endif
5343 end if
5344# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5346 end if
5347
5348 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
5349 call nvtxstartrange("WENO-INTCOMP")
5350 call s_thinc_compression(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno, is2_weno, is3_weno)
5351 call nvtxendrange()
5352 end if
5353
5354 end subroutine s_weno
5355
5356 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5357 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf, weno_dir)
5358
5359 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5360 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5361 integer, intent(in) :: weno_dir
5362 integer :: i, j, k, l
5363 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5364 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5365 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5366 ! the cell- average variables.
5367 real(wp) :: vL_UL, vR_UL
5368 real(wp) :: vL_MD, vR_MD
5369 real(wp) :: vL_LC, vR_LC
5370 real(wp) :: vL_min, vR_min
5371 real(wp) :: vL_max, vR_max
5372 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5373 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5374 real(wp), parameter :: alpha_mp = 2._wp
5375 real(wp), parameter :: beta_mp = 4._wp/3._wp
5376 real(wp) :: vp0, vp1, vp2, vm1, vm2
5377
5378# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5379# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5380# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5381 if (weno_dir == 1) then
5382
5383# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5384
5385# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5386#if defined(MFC_OpenACC)
5387# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5388!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5389# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5390#elif defined(MFC_OpenMP)
5391# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5392
5393# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5394
5395# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5396
5397# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5398!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d, vp0, vp1, vp2, vm1, vm2)
5399# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5400#endif
5401 do l = is3_weno%beg, is3_weno%end
5402 do k = is2_weno%beg, is2_weno%end
5403 do j = is1_weno%beg, is1_weno%end
5404 do i = 1, v_size
5405 ! Second-order undivided differences for curvature estimation
5406
5407 vp0 = v_rs_ws(j, k, l, i)
5408 vm1 = v_rs_ws(j - 1, k, l, i)
5409 vm2 = v_rs_ws(j - 2, k, l, i)
5410 vp1 = v_rs_ws(j + 1, k, l, i)
5411 vp2 = v_rs_ws(j + 2, k, l, i)
5412
5413 d(-1) = vp0 + vm2 - vm1*2._wp
5414 d(0) = vp1 + vm1 - vp0*2._wp
5415 d(1) = vp2 + vp0 - vp1*2._wp
5416
5417 ! Median function for oscillation detection
5418 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5419 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5420 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5421 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5422
5423 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5424 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5425 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5426
5427 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5428
5429 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5430
5431 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5432
5433 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5434
5435 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5436
5437 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5438 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5439 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5440 ! END: Left Monotonicity Preserving Bound
5441
5442 ! Right Monotonicity Preserving Bound
5443 d(-1) = vp0 + vm2 - vm1*2._wp
5444 d(0) = vp1 + vm1 - vp0*2._wp
5445 d(1) = vp2 + vp0 - vp1*2._wp
5446
5447 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5448 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5449 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5450
5451 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5452 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5453 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5454 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5455
5456 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5457
5458 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5459
5460 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5461
5462 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5463
5464 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5465
5466 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5467 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5468 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5469 ! END: Right Monotonicity Preserving Bound
5470 end do
5471 end do
5472 end do
5473 end do
5474
5475# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5476#if defined(MFC_OpenACC)
5477# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5478!$acc end parallel loop
5479# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5480#elif defined(MFC_OpenMP)
5481# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5482
5483# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5484!$omp end target teams loop
5485# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5486#endif
5487 end if
5488# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5489# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5490# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5491 if (weno_dir == 2) then
5492
5493# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5494
5495# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5496#if defined(MFC_OpenACC)
5497# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5498!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5499# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5500#elif defined(MFC_OpenMP)
5501# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5502
5503# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5504
5505# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5506
5507# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5508!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d, vp0, vp1, vp2, vm1, vm2)
5509# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5510#endif
5511 do l = is3_weno%beg, is3_weno%end
5512 do k = is1_weno%beg, is1_weno%end
5513 do j = is2_weno%beg, is2_weno%end
5514 do i = 1, v_size
5515 ! Second-order undivided differences for curvature estimation
5516
5517 vp0 = v_rs_ws(j, k, l, i)
5518 vm1 = v_rs_ws(j, k - 1, l, i)
5519 vm2 = v_rs_ws(j, k - 2, l, i)
5520 vp1 = v_rs_ws(j, k + 1, l, i)
5521 vp2 = v_rs_ws(j, k + 2, l, i)
5522
5523 d(-1) = vp0 + vm2 - vm1*2._wp
5524 d(0) = vp1 + vm1 - vp0*2._wp
5525 d(1) = vp2 + vp0 - vp1*2._wp
5526
5527 ! Median function for oscillation detection
5528 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5529 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5530 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5531 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5532
5533 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5534 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5535 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5536
5537 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5538
5539 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5540
5541 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5542
5543 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5544
5545 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5546
5547 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5548 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5549 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5550 ! END: Left Monotonicity Preserving Bound
5551
5552 ! Right Monotonicity Preserving Bound
5553 d(-1) = vp0 + vm2 - vm1*2._wp
5554 d(0) = vp1 + vm1 - vp0*2._wp
5555 d(1) = vp2 + vp0 - vp1*2._wp
5556
5557 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5558 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5559 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5560
5561 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5562 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5563 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5564 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5565
5566 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5567
5568 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5569
5570 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5571
5572 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5573
5574 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5575
5576 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5577 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5578 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5579 ! END: Right Monotonicity Preserving Bound
5580 end do
5581 end do
5582 end do
5583 end do
5584
5585# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5586#if defined(MFC_OpenACC)
5587# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5588!$acc end parallel loop
5589# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5590#elif defined(MFC_OpenMP)
5591# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5592
5593# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5594!$omp end target teams loop
5595# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5596#endif
5597 end if
5598# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5600# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601 if (weno_dir == 3) then
5602
5603# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5604
5605# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5606#if defined(MFC_OpenACC)
5607# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5608!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5609# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5610#elif defined(MFC_OpenMP)
5611# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5612
5613# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5614
5615# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5616
5617# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5618!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d, vp0, vp1, vp2, vm1, vm2)
5619# 1498 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5620#endif
5621 do l = is1_weno%beg, is1_weno%end
5622 do k = is2_weno%beg, is2_weno%end
5623 do j = is3_weno%beg, is3_weno%end
5624 do i = 1, v_size
5625 ! Second-order undivided differences for curvature estimation
5626
5627 vp0 = v_rs_ws(j, k, l, i)
5628 vm1 = v_rs_ws(j, k, l - 1, i)
5629 vm2 = v_rs_ws(j, k, l - 2, i)
5630 vp1 = v_rs_ws(j, k, l + 1, i)
5631 vp2 = v_rs_ws(j, k, l + 2, i)
5632
5633 d(-1) = vp0 + vm2 - vm1*2._wp
5634 d(0) = vp1 + vm1 - vp0*2._wp
5635 d(1) = vp2 + vp0 - vp1*2._wp
5636
5637 ! Median function for oscillation detection
5638 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5639 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5640 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5641 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5642
5643 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5644 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5645 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5646
5647 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5648
5649 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5650
5651 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5652
5653 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5654
5655 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5656
5657 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5658 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5659 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5660 ! END: Left Monotonicity Preserving Bound
5661
5662 ! Right Monotonicity Preserving Bound
5663 d(-1) = vp0 + vm2 - vm1*2._wp
5664 d(0) = vp1 + vm1 - vp0*2._wp
5665 d(1) = vp2 + vp0 - vp1*2._wp
5666
5667 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5668 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5669 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5670
5671 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5672 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5673 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5674 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5675
5676 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5677
5678 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5679
5680 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5681
5682 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5683
5684 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5685
5686 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5687 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5688 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5689 ! END: Right Monotonicity Preserving Bound
5690 end do
5691 end do
5692 end do
5693 end do
5694
5695# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5696#if defined(MFC_OpenACC)
5697# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5698!$acc end parallel loop
5699# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5700#elif defined(MFC_OpenMP)
5701# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5702
5703# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5704!$omp end target teams loop
5705# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5706#endif
5707 end if
5708# 1575 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5709
5710 end subroutine s_preserve_monotonicity
5711
5712 !> Module deallocation and/or disassociation procedures
5713 impure subroutine s_finalize_weno_module()
5714
5715 if (weno_order == 1) return
5716
5717 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5718
5719#ifdef MFC_DEBUG
5720# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721 block
5722# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723 use iso_fortran_env, only: output_unit
5724# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5725
5726# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5727 print *, 'm_weno.fpp:1585: ', '@:DEALLOCATE(v_rs_weno)'
5728# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5729
5730# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5731 call flush (output_unit)
5732# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5733 end block
5734# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5735#endif
5736# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5737
5738# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5739#if defined(MFC_OpenACC)
5740# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5741!$acc exit data delete(v_rs_weno)
5742# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5743#elif defined(MFC_OpenMP)
5744# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5745!$omp target exit data map(release:v_rs_weno)
5746# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5747#endif
5748# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5749 deallocate (v_rs_weno)
5750
5751 ! Deallocating WENO coefficients in x-direction
5752#ifdef MFC_DEBUG
5753# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5754 block
5755# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5756 use iso_fortran_env, only: output_unit
5757# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5758
5759# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5760 print *, 'm_weno.fpp:1588: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5761# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5762
5763# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5764 call flush (output_unit)
5765# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5766 end block
5767# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5768#endif
5769# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5770
5771# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5772#if defined(MFC_OpenACC)
5773# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5774!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5775# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5776#elif defined(MFC_OpenMP)
5777# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5778!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5779# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5780#endif
5781# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5782 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5783#ifdef MFC_DEBUG
5784# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5785 block
5786# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5787 use iso_fortran_env, only: output_unit
5788# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5789
5790# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5791 print *, 'm_weno.fpp:1589: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5792# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5793
5794# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5795 call flush (output_unit)
5796# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5797 end block
5798# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5799#endif
5800# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5801
5802# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5803#if defined(MFC_OpenACC)
5804# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5805!$acc exit data delete(d_cbL_x, d_cbR_x)
5806# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5807#elif defined(MFC_OpenMP)
5808# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5809!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5810# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5811#endif
5812# 1589 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5813 deallocate (d_cbl_x, d_cbr_x)
5814#ifdef MFC_DEBUG
5815# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5816 block
5817# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5818 use iso_fortran_env, only: output_unit
5819# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5820
5821# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5822 print *, 'm_weno.fpp:1590: ', '@:DEALLOCATE(beta_coef_x)'
5823# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5824
5825# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5826 call flush (output_unit)
5827# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5828 end block
5829# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5830#endif
5831# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5832
5833# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5834#if defined(MFC_OpenACC)
5835# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5836!$acc exit data delete(beta_coef_x)
5837# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5838#elif defined(MFC_OpenMP)
5839# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840!$omp target exit data map(release:beta_coef_x)
5841# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842#endif
5843# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844 deallocate (beta_coef_x)
5845
5846 ! Deallocating WENO coefficients in y-direction
5847 if (n == 0) return
5848
5849#ifdef MFC_DEBUG
5850# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5851 block
5852# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5853 use iso_fortran_env, only: output_unit
5854# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5855
5856# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5857 print *, 'm_weno.fpp:1595: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5858# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5859
5860# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5861 call flush (output_unit)
5862# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5863 end block
5864# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5865#endif
5866# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5867
5868# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5869#if defined(MFC_OpenACC)
5870# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5871!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5872# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873#elif defined(MFC_OpenMP)
5874# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5876# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877#endif
5878# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5880#ifdef MFC_DEBUG
5881# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5882 block
5883# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5884 use iso_fortran_env, only: output_unit
5885# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5886
5887# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5888 print *, 'm_weno.fpp:1596: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5889# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5890
5891# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5892 call flush (output_unit)
5893# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5894 end block
5895# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5896#endif
5897# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5898
5899# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5900#if defined(MFC_OpenACC)
5901# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5902!$acc exit data delete(d_cbL_y, d_cbR_y)
5903# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5904#elif defined(MFC_OpenMP)
5905# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5906!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5907# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5908#endif
5909# 1596 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910 deallocate (d_cbl_y, d_cbr_y)
5911#ifdef MFC_DEBUG
5912# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5913 block
5914# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5915 use iso_fortran_env, only: output_unit
5916# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5917
5918# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5919 print *, 'm_weno.fpp:1597: ', '@:DEALLOCATE(beta_coef_y)'
5920# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5921
5922# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5923 call flush (output_unit)
5924# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5925 end block
5926# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5927#endif
5928# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5929
5930# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5931#if defined(MFC_OpenACC)
5932# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5933!$acc exit data delete(beta_coef_y)
5934# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5935#elif defined(MFC_OpenMP)
5936# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5937!$omp target exit data map(release:beta_coef_y)
5938# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5939#endif
5940# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5941 deallocate (beta_coef_y)
5942
5943 ! Deallocating WENO coefficients in z-direction
5944 if (p == 0) return
5945
5946#ifdef MFC_DEBUG
5947# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5948 block
5949# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5950 use iso_fortran_env, only: output_unit
5951# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5952
5953# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5954 print *, 'm_weno.fpp:1602: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5955# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5956
5957# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5958 call flush (output_unit)
5959# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5960 end block
5961# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5962#endif
5963# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5964
5965# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5966#if defined(MFC_OpenACC)
5967# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5968!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5969# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5970#elif defined(MFC_OpenMP)
5971# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5972!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
5973# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5974#endif
5975# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5976 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
5977#ifdef MFC_DEBUG
5978# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5979 block
5980# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5981 use iso_fortran_env, only: output_unit
5982# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5983
5984# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5985 print *, 'm_weno.fpp:1603: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
5986# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5987
5988# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5989 call flush (output_unit)
5990# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5991 end block
5992# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5993#endif
5994# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5995
5996# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5997#if defined(MFC_OpenACC)
5998# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5999!$acc exit data delete(d_cbL_z, d_cbR_z)
6000# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6001#elif defined(MFC_OpenMP)
6002# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6003!$omp target exit data map(release:d_cbL_z, d_cbR_z)
6004# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6005#endif
6006# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6007 deallocate (d_cbl_z, d_cbr_z)
6008#ifdef MFC_DEBUG
6009# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6010 block
6011# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6012 use iso_fortran_env, only: output_unit
6013# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6014
6015# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6016 print *, 'm_weno.fpp:1604: ', '@:DEALLOCATE(beta_coef_z)'
6017# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6018
6019# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6020 call flush (output_unit)
6021# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6022 end block
6023# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6024#endif
6025# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6026
6027# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6028#if defined(MFC_OpenACC)
6029# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6030!$acc exit data delete(beta_coef_z)
6031# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6032#elif defined(MFC_OpenMP)
6033# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6034!$omp target exit data map(release:beta_coef_z)
6035# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6036#endif
6037# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6038 deallocate (beta_coef_z)
6039
6040 end subroutine s_finalize_weno_module
6041
6042end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::weno_polyn
integer weno_polyn
Degree of the WENO polynomials (polyn).
Definition m_global_parameters.fpp.f90:445
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:927
m_global_parameters::weno_order
integer weno_order
Order of the WENO reconstruction.
Definition m_global_parameters.fpp.f90:447
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:352
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:352
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_thinc
THINC and MTHINC interface compression for volume fraction sharpening. THINC (int_comp=1): 1D directi...
Definition m_thinc.fpp.f90:323
m_thinc::s_thinc_compression
subroutine, public s_thinc_compression(v_rs_ws, vl_rs_vf_x, vr_rs_vf_x, recon_dir, is1_d, is2_d, is3_d)
Applies THINC (int_comp=1) or MTHINC (int_comp=2) interface compression to sharpen volume-fraction an...
Definition m_thinc.fpp.f90:832
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:327
m_weno::s_preserve_monotonicity
subroutine s_preserve_monotonicity(v_rs_ws, vl_rs_vf, vr_rs_vf, weno_dir)
Enforce monotonicity-preserving bounds on the WENO reconstruction.
Definition m_weno.fpp.f90:5358
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:466
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:399
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:363
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:487
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:466
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:398
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:421
m_weno::s_pack_weno_input_arr
subroutine, public s_pack_weno_input_arr(v_vf)
Definition m_weno.fpp.f90:3104
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:401
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:420
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:422
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:400
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:402
m_weno::uniform_grid
logical, dimension(3) uniform_grid
True if grid spacing is uniform in each direction.
Definition m_weno.fpp.f90:451
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:365
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:366
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:438
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:397
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:466
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:367
m_weno::v_rs_weno
real(wp), dimension(:,:,:,:), allocatable v_rs_weno
Definition m_weno.fpp.f90:342
m_weno::s_weno
subroutine, public s_weno(v_vf, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
Definition m_weno.fpp.f90:3156
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:364
m_weno::s_compute_weno_coefficients
subroutine s_compute_weno_coefficients(weno_dir, is)
Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction.
Definition m_weno.fpp.f90:1082
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:368
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5714
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411