MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_icpp_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_icpp_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp" 1
18!> Allocate memory and read initial condition data for IC extrusion.
19!>
20!> @details
21!> This macro handles the complete initialization process for IC extrusion by:
22!>
23!> **Memory Allocation:**
24!> - stored_values(xRows, yRows, sys_size) - stores primitive variable data from files
25!> - x_coords(nrows) - stores x-coordinates from input files
26!> - y_coords(nrows) - stores y-coordinates from input files (3D case only)
27!>
28!> **File Reading Operations:**
29!> - Reads primitive variable data from multiple files with pattern:
30!> `prim.<file_number>.00.<timestep>.dat` where timestep uses `zeros_default` padding
31!> - Files are read from directory specified by `init_dir` parameter
32!> - Supports 1D, 2D, and 3D computational domains
33!>
34!> **Grid Structure Detection:**
35!> - 1D/2D: Counts lines in first file to determine xRows
36!> - 3D: Analyzes coordinate patterns to determine xRows and yRows structure
37!>
38!> **MPI Domain Mapping:**
39!> - Calculates global_offset_x and global_offset_y for MPI subdomain positioning
40!> - Maps file coordinates to local computational grid coordinates
41!>
42!> **Data Assignment:**
43!> - Populates q_prim_vf primitive variable arrays with file data
44!> - Handles momentum component indexing with special treatment for eqn_idx%mom%end
45!> - Sets eqn_idx%mom%end component to zero for 2D/3D cases
46!>
47!> **State Management:**
48!> - Uses files_loaded flag to prevent redundant file operations
49!> - Preserves data across multiple macro calls within same simulation
50!>
51!> @note File pattern uses `zeros_default` parameter (default: "000000") for timestep padding
52!> @note Directory path is hardcoded in `init_dir` parameter - modify as needed
53!> @warning Aborts execution if file reading errors occur.
54
55# 56 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
56
57# 194 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 205 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
60# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
61# 1 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp" 1
62# 5 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
63
64# 74 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
65# 8 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
66# 1 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp" 1
67# 32 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 395 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
70# 9 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
71# 1 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp" 1
72# 66 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 186 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
75# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
76# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
77# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
78# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
79# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96
97# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98
99# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
100
101# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
102! New line at end of file is required for FYPP
103# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
104# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
105# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
106# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
107# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
108# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
110# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111
112# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
114# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115
116# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
117
118# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
119
120# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121
122# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123
124# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
125
126# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127
128# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
129! New line at end of file is required for FYPP
130# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
131
132# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
184
185# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
186
187# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
188
189# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
190
191# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
192
193# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
194
195# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
196
197# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
198
199# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
200
201# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
202
203# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
204
205# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
206
207# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
208! New line at end of file is required for FYPP
209# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
210# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
211# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
212# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
213# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
215# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
217
218# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
219# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
220# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
221
222# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
223
224# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
225
226# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
227
228# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
229
230# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
231
232# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
233
234# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
235! New line at end of file is required for FYPP
236# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
237
238# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273
274# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
275
276# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
277
278# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
279
280# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
281
282# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
283
284# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
285
286# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
287
288# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
289
290# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
291
292# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
293! New line at end of file is required for FYPP
294# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
295
296! GPU parallel region (scalar reductions, maxval/minval)
297# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298
299! GPU parallel loop over threads (most common GPU macro)
300# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301
302! Required closing for GPU_PARALLEL_LOOP
303# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
304
305! Mark routine for device compilation
306# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308! Declare device-resident data
309# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
310
311! Inner loop within a GPU parallel region
312# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314! Scoped GPU data region
315# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
316
317! Host code with device pointers (for MPI with GPU buffers)
318# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320! Allocate device memory (unscoped)
321# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
322
323! Free device memory
324# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326! Atomic operation on device
327# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
328
329! End atomic capture block
330# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332! Copy data between host and device
333# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334
335! Synchronization barrier
336# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
337
338! Import GPU library module (openacc or omp_lib)
339# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
340
341! Emit code only for AMD compiler
342# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
343
344! Emit code for non-Cray compilers
345# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
346
347! Emit code only for Cray compiler
348# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
349
350! Emit code for non-NVIDIA compilers
351# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
352
353# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
354# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
355! New line at end of file is required for FYPP
356# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
357
358# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
359
360! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
361! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
362! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
363# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
364
365! Allocate and create GPU device memory
366# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
367
368! Free GPU device memory and deallocate
369# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
370
371! Cray-specific GPU pointer setup for vector fields
372# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
373
374! Cray-specific GPU pointer setup for scalar fields
375# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
376
377! Cray-specific GPU pointer setup for acoustic source spatials
378# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
379
380# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
381
382# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
383! New line at end of file is required for FYPP
384# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
385
386!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
387module m_icpp_patches
388
389 use m_model ! Subroutine(s) related to STL files
390 use m_derived_types ! Definitions of the derived types
391 use m_global_parameters
392 use m_constants, only: max_2d_fourier_modes, max_sph_harm_degree, small_radius, model_eqns_4eq
393 use m_helper_basic
394 use m_helper
395 use m_mpi_common
396 use m_assign_variables
397 use m_mpi_common
398 use m_variables_conversion
399
400 implicit none
401
402 private; public :: s_apply_icpp_patches
403
404 real(wp) :: x_centroid, y_centroid, z_centroid
405 real(wp) :: length_x, length_y, length_z
406 integer :: smooth_patch_id
407 real(wp) :: smooth_coeff !< Smoothing coefficient (mirrors ic_patch_parameters%smooth_coeff)
408 real(wp) :: eta !< Pseudo volume fraction for patch boundary smoothing
409 real(wp) :: cart_y, cart_z
410 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
411 character(len=5) :: istr !< string to store int to string result for error checking
412
413contains
414
415 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
416 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
417
418 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
419
420#ifdef MFC_MIXED_PRECISION
421 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
422#else
423 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
424#endif
425 integer :: i
426 ! Load STL/OBJ models once into the shared flat arrays if any patch is an STL/OBJ model (geometry 21)
427
428 do i = 1, num_patches
429 if (patch_icpp(i)%geometry == 21) then
430 call s_instantiate_stl_models()
431 exit
432 end if
433 end do
434 ! 3D Patch Geometries
435
436 if (p > 0) then
437 do i = 1, num_patches
438 if (proc_rank == 0) then
439 print *, 'Processing patch', i
440 end if
441
442 !> ICPP Patches
443 !> @{
444 ! Spherical patch
445 if (patch_icpp(i)%geometry == 8) then
446 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
447 ! Cuboidal patch
448 else if (patch_icpp(i)%geometry == 9) then
449 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
450 ! Cylindrical patch
451 else if (patch_icpp(i)%geometry == 10) then
452 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
453 ! Swept plane patch
454 else if (patch_icpp(i)%geometry == 11) then
455 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
456 ! Ellipsoidal patch
457 else if (patch_icpp(i)%geometry == 12) then
458 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
459 ! 3D spherical harmonic patch
460 else if (patch_icpp(i)%geometry == 14) then
461 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
462 ! 3D Modified circular patch
463 else if (patch_icpp(i)%geometry == 19) then
464 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
465 ! 3D STL patch
466 else if (patch_icpp(i)%geometry == 21) then
467 call s_icpp_model(i, patch_id_fp, q_prim_vf)
468 end if
469 end do
470 !> @}
471
472 ! 2D Patch Geometries
473 else if (n > 0) then
474 do i = 1, num_patches
475 if (proc_rank == 0) then
476 print *, 'Processing patch', i
477 end if
478
479 !> ICPP Patches
480 !> @{
481 ! Circular patch
482 if (patch_icpp(i)%geometry == 2) then
483 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
484 ! Rectangular patch
485 else if (patch_icpp(i)%geometry == 3) then
486 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
487 ! Swept line patch
488 else if (patch_icpp(i)%geometry == 4) then
489 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
490 ! Elliptical patch
491 else if (patch_icpp(i)%geometry == 5) then
492 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
493 ! Unimplemented patch (formerly isentropic vortex)
494 else if (patch_icpp(i)%geometry == 6) then
495 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
496 & // 'which no longer exists. See Examples. Exiting.')
497 ! 2D modal (Fourier) patch
498 else if (patch_icpp(i)%geometry == 13) then
499 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
500 ! Spiral patch
501 else if (patch_icpp(i)%geometry == 17) then
502 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
503 ! Modified circular patch
504 else if (patch_icpp(i)%geometry == 18) then
505 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
506 ! TaylorGreen vortex patch
507 else if (patch_icpp(i)%geometry == 20) then
508 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
509 ! STL patch
510 else if (patch_icpp(i)%geometry == 21) then
511 call s_icpp_model(i, patch_id_fp, q_prim_vf)
512 end if
513 !> @}
514 end do
515
516 ! 1D Patch Geometries
517 else
518 do i = 1, num_patches
519 if (proc_rank == 0) then
520 print *, 'Processing patch', i
521 end if
522
523 ! Line segment patch
524 if (patch_icpp(i)%geometry == 1) then
525 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
526 ! 1d analytical
527 else if (patch_icpp(i)%geometry == 16) then
528 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
529 end if
530 end do
531 end if
532
533 end subroutine s_apply_icpp_patches
534
535 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
536 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
537 !! patch DOES NOT allow for the smearing of its boundaries.
538 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
539
540 integer, intent(in) :: patch_id
541
542#ifdef MFC_MIXED_PRECISION
543 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
544#else
545 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
546#endif
547 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
548
549 ! Generic loop iterators
550 integer :: i, j, k
551
552 ! Placeholders for the cell boundary values
553 real(wp) :: pi_inf, gamma, lit_gamma
554
555 integer :: xRows, yRows, nRows, iix, iiy, max_files
556# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
557 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
558# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
559 real(wp) :: x_len, x_step, y_len, y_step
560# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
561 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
562# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
563 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
564# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
565 real(wp) :: delta_x, delta_y
566# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
567 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
568# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
569 character(len=200) :: errmsg
570# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
571 real(wp), allocatable :: stored_values(:,:,:)
572# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
573 real(wp), allocatable :: x_coords(:), y_coords(:)
574# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
575 logical :: files_loaded = .false.
576# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
577 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
578# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
579 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
580# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
581 character(len=20) :: file_num_str !< For storing the file number as a string
582# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
583 character(len=20) :: zeros_part !< For the trailing zeros part
584# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
585 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
586 ! Place any declaration of intermediate variables here
587# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
588 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
589
590 pi_inf = pi_infs(1)
591 gamma = gammas(1)
592 lit_gamma = gs_min(1)
593 j = 0
594 k = 0
595
596 ! Transferring the line segment's centroid and length information
597 x_centroid = patch_icpp(patch_id)%x_centroid
598 length_x = patch_icpp(patch_id)%length_x
599
600 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
601 x_boundary%beg = x_centroid - 0.5_wp*length_x
602 x_boundary%end = x_centroid + 0.5_wp*length_x
603
604 ! Set eta=1 (no smoothing for this patch type)
605 eta = 1._wp
606
607 ! Assign patch vars if cell is covered and patch has write permission
608 do i = 0, m
609 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, &
610 & 0, 0))) then
611 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
612
613
614
615 ! check if this should load a hardcoded patch
616 if (patch_icpp(patch_id)%hcid /= dflt_int) then
617 select case (patch_icpp(patch_id)%hcid)
618# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
619 case (150) ! 1D Smooth Alfven Case for MHD
620# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
621 ! velocity
622# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
623 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
624# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
625 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
626# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
627
628# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
629 ! magnetic field
630# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
631 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
632# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
633 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
634# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
635 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
636# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
637 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
638# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
639 ! SDtoolbox)
640# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
641 if (.not. files_loaded) then
642# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
643 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
644# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
645 do f = 1, max_files
646# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
647 write (file_num_str, '(I0)') f
648# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
649 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
650# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
651 end do
652# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
653
654# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
655 ! Common file reading setup
656# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
657 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
658# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
659 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
660# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
661
662# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
663 select case (num_dims)
664# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
665 case (1, 2) ! 1D and 2D cases are similar
666# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
667 ! Count lines
668# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
669 line_count = 0
670# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
671 do
672# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
673 read (unit2, *, iostat=ios2) dummy_x, dummy_y
674# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
675 if (ios2 /= 0) exit
676# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
677 line_count = line_count + 1
678# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
679 end do
680# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
681 close (unit2)
682# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
683
684# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
685 xrows = line_count
686# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
687 yrows = 1
688# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
689 index_x = 0
690# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
691 if (num_dims == 2) index_x = i
692# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
693#ifdef MFC_DEBUG
694# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
695 block
696# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
697 use iso_fortran_env, only: output_unit
698# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
699
700# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
701 print *, 'm_icpp_patches.fpp:211: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
702# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
703
704# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
705 call flush (output_unit)
706# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
707 end block
708# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
709#endif
710# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
711 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
712# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
713
714# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
715
716# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
717
718# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
719#if defined(MFC_OpenACC)
720# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
721!$acc enter data create(x_coords, stored_values)
722# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
723#elif defined(MFC_OpenMP)
724# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
725!$omp target enter data map(always,alloc:x_coords, stored_values)
726# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
727#endif
728# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
729
730# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
731 ! Read data from all files
732# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
733 do f = 1, max_files
734# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
735 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
736# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
737 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
738# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
739
740# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
741 do iter = 1, xrows
742# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
743 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
744# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
745 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
746# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
747 end do
748# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
749 close (unit)
750# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
751 end do
752# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
753
754# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
755 ! Calculate offsets
756# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
757 domain_xstart = x_coords(1)
758# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
759 x_step = x_cc(1) - x_cc(0)
760# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
761 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
762# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
763 global_offset_x = nint(abs(delta_x)/x_step)
764# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
765 case (3) ! 3D case - determine grid structure
766# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
767 ! Find yRows by counting rows with same x
768# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
769 read (unit2, *, iostat=ios2) x0, y0, dummy_z
770# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
771 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
772# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
773
774# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
775 yrows = 1
776# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
777 do
778# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
779 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
780# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
781 if (ios2 /= 0) exit
782# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
783 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
784# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
785 yrows = yrows + 1
786# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
787 else
788# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
789 exit
790# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
791 end if
792# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
793 end do
794# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
795 close (unit2)
796# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
797
798# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
799 ! Count total rows
800# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
801 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
802# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
803 nrows = 0
804# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
805 do
806# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
807 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
808# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
809 if (ios2 /= 0) exit
810# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
811 nrows = nrows + 1
812# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
813 end do
814# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
815 close (unit2)
816# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
817
818# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
819 xrows = nrows/yrows
820# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
821#ifdef MFC_DEBUG
822# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
823 block
824# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
825 use iso_fortran_env, only: output_unit
826# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
827
828# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
829 print *, 'm_icpp_patches.fpp:211: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
830# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
831
832# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
833 call flush (output_unit)
834# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
835 end block
836# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
837#endif
838# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
839 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
840# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
841
842# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
843
844# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
845
846# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
847
848# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
849#if defined(MFC_OpenACC)
850# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
851!$acc enter data create(x_coords, y_coords, stored_values)
852# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
853#elif defined(MFC_OpenMP)
854# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
855!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
856# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
857#endif
858# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
859 index_x = i
860# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
861 index_y = j
862# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
863
864# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
865 ! Read all files
866# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
867 do f = 1, max_files
868# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
869 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
870# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
871 if (ios /= 0) then
872# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
873 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
874# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
875 cycle
876# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
877 end if
878# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
879
880# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
881 iter = 0
882# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
883 do iix = 1, xrows
884# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
885 do iiy = 1, yrows
886# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
887 iter = iter + 1
888# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
889 if (f == 1) then
890# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
891 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
892# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
893 else
894# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
895 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
896# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
897 end if
898# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
899 if (ios /= 0) call s_mpi_abort("Error reading data")
900# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
901 end do
902# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
903 end do
904# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
905 close (unit)
906# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
907 end do
908# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
909
910# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
911 ! Calculate offsets
912# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
913 x_step = x_cc(1) - x_cc(0)
914# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
915 y_step = y_cc(1) - y_cc(0)
916# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
917 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
918# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
919 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
920# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
921 global_offset_x = nint(abs(delta_x)/x_step)
922# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
923 global_offset_y = nint(abs(delta_y)/y_step)
924# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
925 end select
926# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
927
928# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
929 files_loaded = .true.
930# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
931 end if
932# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
933
934# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
935 ! Data assignment
936# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
937 select case (num_dims)
938# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
939 case (1)
940# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
941 idx = i + 1 + global_offset_x
942# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
943 do f = 1, sys_size
944# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
945 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
946# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
947 end do
948# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
949 case (2)
950# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
951 idx = i + 1 + global_offset_x - index_x
952# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
953 do f = 1, sys_size - 1
954# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
955 jump = merge(1, 0, f >= eqn_idx%mom%end)
956# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
957 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
958# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
959 end do
960# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
961 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
962# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
963 case (3)
964# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
965 idx = i + 1 + global_offset_x - index_x
966# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
967 idy = j + 1 + global_offset_y - index_y
968# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
969 do f = 1, sys_size - 1
970# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
971 jump = merge(1, 0, f >= eqn_idx%mom%end)
972# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
973 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
974# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
975 end do
976# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
977 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
978# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
979 end select
980# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
981 case (180) ! Shu-Osher problem
982# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
983 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
984# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
985 ! 0.2*sin(5*x)"
986# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
987 if (patch_id == 2) then
988# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
989 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
990# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
991 end if
992# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
993 case (181) ! Titarev-Torro problem
994# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
995 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
996# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
997 ! "1 + 0.1*sin(20*x*pi)"
998# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
999 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1000# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1001 case (182) ! Multi-component diffusion
1002# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1003 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1004# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1005 x_mid_diffu = 0.05_wp/2.0_wp
1006# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1007 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1008# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1009 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1010# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1011 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1012# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1013 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1014# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1015 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
1016# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1017
1018# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1019 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1020# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1021 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1022# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1023 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1024# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1025 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1026# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1027
1028# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1029 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
1030# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1031 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
1032# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1033 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
1034# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1035 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
1036# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1037
1038# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1039 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1040# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1041
1042# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1043 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1044# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1045
1046# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1047 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1048# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1049
1050# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1051 case(191) ! 1D Dual Isothermal case
1052# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1053
1054# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1055 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
1056# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1057 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1058# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1059 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
1060# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1061
1062# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1063 if (x_cc(i) <= 0.025_wp) then
1064# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1065 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
1066# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1067 else
1068# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1069 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
1070# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1071 end if
1072# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1073
1074# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1075 molar_mass_inv = 1.0_wp/2.01588_wp
1076# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1077 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1078# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1079 case default
1080# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1081 call s_int_to_str(patch_id, istr)
1082# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1083 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1084# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1085 end select
1086 end if
1087
1088 ! Updating the patch identities bookkeeping variable
1089 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1090 end if
1091 end do
1092 if (allocated(stored_values)) then
1093# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1094#ifdef MFC_DEBUG
1095# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1096 block
1097# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1098 use iso_fortran_env, only: output_unit
1099# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1100
1101# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1102 print *, 'm_icpp_patches.fpp:218: ', '@:DEALLOCATE(stored_values)'
1103# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1104
1105# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1106 call flush (output_unit)
1107# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1108 end block
1109# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1110#endif
1111# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1112
1113# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1114#if defined(MFC_OpenACC)
1115# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1116!$acc exit data delete(stored_values)
1117# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1118#elif defined(MFC_OpenMP)
1119# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1120!$omp target exit data map(release:stored_values)
1121# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1122#endif
1123# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1124 deallocate (stored_values)
1125# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1126#ifdef MFC_DEBUG
1127# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1128 block
1129# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1130 use iso_fortran_env, only: output_unit
1131# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1132
1133# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1134 print *, 'm_icpp_patches.fpp:218: ', '@:DEALLOCATE(x_coords)'
1135# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1136
1137# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1138 call flush (output_unit)
1139# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1140 end block
1141# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1142#endif
1143# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1144
1145# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1146#if defined(MFC_OpenACC)
1147# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1148!$acc exit data delete(x_coords)
1149# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1150#elif defined(MFC_OpenMP)
1151# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1152!$omp target exit data map(release:x_coords)
1153# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1154#endif
1155# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1156 deallocate (x_coords)
1157# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1158 end if
1159# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1160
1161# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1162 if (allocated(y_coords)) then
1163# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1164#ifdef MFC_DEBUG
1165# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1166 block
1167# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1168 use iso_fortran_env, only: output_unit
1169# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1170
1171# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1172 print *, 'm_icpp_patches.fpp:218: ', '@:DEALLOCATE(y_coords)'
1173# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1174
1175# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1176 call flush (output_unit)
1177# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1178 end block
1179# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1180#endif
1181# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1182
1183# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1184#if defined(MFC_OpenACC)
1185# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1186!$acc exit data delete(y_coords)
1187# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1188#elif defined(MFC_OpenMP)
1189# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1190!$omp target exit data map(release:y_coords)
1191# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1192#endif
1193# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1194 deallocate (y_coords)
1195# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1196 end if
1197
1198 end subroutine s_icpp_line_segment
1199
1200 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1201 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1202 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1203
1204 integer, intent(in) :: patch_id
1205
1206#ifdef MFC_MIXED_PRECISION
1207 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1208#else
1209 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1210#endif
1211 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1212 integer :: i, j, k !< Generic loop iterators
1213 real(wp) :: th, thickness, nturns, mya
1214 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1215
1216 integer :: xrows, yrows, nrows, iix, iiy, max_files
1217# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1218 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1219# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1220 real(wp) :: x_len, x_step, y_len, y_step
1221# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1222 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1223# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1224 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1225# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1226 real(wp) :: delta_x, delta_y
1227# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1228 character(len=100), dimension(sys_size) :: filenames !< Arrays to store all data from files
1229# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1230 character(len=200) :: errmsg
1231# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1232 real(wp), allocatable :: stored_values(:,:,:)
1233# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1234 real(wp), allocatable :: x_coords(:), y_coords(:)
1235# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1236 logical :: files_loaded = .false.
1237# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1238 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1239# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1240 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
1241# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1242 character(len=20) :: file_num_str !< For storing the file number as a string
1243# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1244 character(len=20) :: zeros_part !< For the trailing zeros part
1245# 238 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1246 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
1247 ! Place any declaration of intermediate variables here
1248# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1249 real(wp) :: eps, eps_mhd, c_mhd
1250# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1251 real(wp) :: r, rmax, gam, umax, p0
1252# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1253 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1254# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1255 real(wp) :: factor
1256# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1257 real(wp) :: r0, alpha, r2
1258# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1259 real(wp) :: sina, cosa
1260# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1261 real(wp) :: r_sq
1262# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1263
1264# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1265 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
1266# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1267 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, t_facq, wq
1268# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1269 real(wp) :: rho_avg, rhou_avg, rhov_avg, e_avg
1270# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1271 real(wp) :: rhoq, pq, uq, vq, eq, vortex_eps
1272# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1273 integer :: igq, jgq
1274# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1275
1276# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1277 ! # 291 - Shear/Thermal Layer Case
1278# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1279 real(wp) :: delta_shear, u_max, u_mean
1280# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1281 real(wp) :: t_wall, t_inf, p_atm, t_loc
1282# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1283 real(wp) :: delta_th, r_mix
1284# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1285 real(wp) :: y_n2, y_o2, mw_n2, mw_o2
1286# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1287 real(wp) :: bottom_blend_u, bottom_blend_t
1288# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1289
1290# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1291 ! # 207
1292# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1293 real(wp) :: sigma, gauss1, gauss2
1294# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1295
1296# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1297 ! # 208
1298# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1299 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1300# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1301
1302# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1303 eps = 1.e-9_wp
1304
1305 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1306 x_centroid = patch_icpp(patch_id)%x_centroid
1307 y_centroid = patch_icpp(patch_id)%y_centroid
1308 mya = patch_icpp(patch_id)%radius
1309 thickness = patch_icpp(patch_id)%length_x
1310 nturns = patch_icpp(patch_id)%length_y
1311
1312 !
1313 logic_grid = 0
1314 do k = 0, int(m*91*nturns)
1315 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1316
1317 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1318 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1319
1320 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1321 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1322
1323 do j = 0, n; do i = 0, m
1324 if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. (y_cc(j) > spiral_y_min) .and. (y_cc(j) &
1325 & < spiral_y_max)) then
1326 logic_grid(i, j, 0) = 1
1327 end if
1328 end do; end do
1329 end do
1330
1331 do j = 0, n
1332 do i = 0, m
1333 if ((logic_grid(i, j, 0) == 1)) then
1334 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1335
1336
1337 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1338 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1339# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1340 case (200) ! Two-fluid cubic interface
1341# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1342 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1343# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1344 ! Volume Fractions
1345# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1346 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
1347# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1348 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
1349# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1350 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
1351# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1352 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
1353# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1354 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
1355# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1356 end if
1357# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1358 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1359# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1360 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1361# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1362 rmax = 0.2_wp
1363# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1364
1365# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1366 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1367# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1368 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1369# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1370 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1371# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1372
1373# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1374 if (r < rmax) then
1375# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1376 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1377# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1378 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1379# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1380 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1381# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1382 else if (r < 2*rmax) then
1383# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1384 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1385# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1386 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1387# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1388 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
1389# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1390 else
1391# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1392 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1393# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1394 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1395# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1396 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1397# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1398 end if
1399# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1400 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1401# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1402 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1403# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1404 rmax = 0.2_wp
1405# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1406
1407# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1408 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1409# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1410 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1411# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1412 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1413# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1414
1415# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1416 if (r < rmax) then
1417# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1418 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1419# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1420 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1421# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1422 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1423# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1424 else if (r < 2*rmax) then
1425# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1426 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1427# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1428 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1429# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1430 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
1431# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1432 else
1433# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1434 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1435# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1436 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1437# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1438 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1439# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1440 end if
1441# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1442
1443# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1444 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
1445# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1446 case (204) ! Rayleigh-Taylor instability
1447# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1448 rhoh = 3._wp
1449# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1450 rhol = 1._wp
1451# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1452 pref = 1.e5_wp
1453# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1454 pint = pref
1455# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1456 h = 0.7_wp
1457# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1458 lam = 0.2_wp
1459# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1460 wl = 2._wp*pi/lam
1461# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1462 amp = 0.05_wp/wl
1463# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1464
1465# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1466 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1467# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1468
1469# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1470 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1471# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1472
1473# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1474 if (alph < eps) alph = eps
1475# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1476 if (alph > 1._wp - eps) alph = 1._wp - eps
1477# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1478
1479# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1480 if (y_cc(j) > inth) then
1481# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1482 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1483# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1484 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1485# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1486 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1487# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1488 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1489# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1490 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1491# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1492 else
1493# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1494 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1495# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1496 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1497# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1498 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1499# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1500 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1501# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1502 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1503# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1504 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1505# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1506 end if
1507# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1508 case (205) ! 2D lung wave interaction problem
1509# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1510 h = 0.0_wp ! non dim origin y
1511# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1512 lam = 1.0_wp ! non dim lambda
1513# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1514 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1515# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1516
1517# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1518 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1519# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1520
1521# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1522 if (y_cc(j) > inth) then
1523# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1524 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1525# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1526 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1527# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1528 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1529# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1530 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1531# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1532 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1533# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1534 end if
1535# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1536 case (206) ! 2D lung wave interaction problem - horizontal domain
1537# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1538 h = 0.0_wp ! non dim origin y
1539# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1540 lam = 1.0_wp ! non dim lambda
1541# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1542 amp = patch_icpp(patch_id)%a(2)
1543# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1544
1545# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1546 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1547# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1548
1549# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1550 if (x_cc(i) > intl) then ! this is the liquid
1551# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1552 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1553# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1554 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1555# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1556 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1557# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1558 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1559# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1560 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1561# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1562 end if
1563# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1564 case (207) ! Kelvin Helmholtz Instability
1565# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1566 sigma = 0.05_wp/sqrt(2.0_wp)
1567# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1568 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1569# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1570 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1571# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1572 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
1573# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1574 case (208) ! Richtmeyer Meshkov Instability
1575# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1576 lam = 1.0_wp
1577# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1578 eps = 1.0e-6_wp
1579# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1580 ei = 5.0_wp
1581# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1582 ! Smoothening function to smooth out sharp discontinuity in the interface
1583# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1584 if (x_cc(i) <= 0.7_wp*lam) then
1585# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1586 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1587# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1588 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1589# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1590 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1591# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1592 alpha_sf6 = 1.0_wp - alpha_air
1593# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1594 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
1595# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1596 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
1597# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1598 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
1599# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1600 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
1601# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1602 end if
1603# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1604 case (250) ! MHD Orszag-Tang vortex
1605# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1606 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
1607# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1608 ! sin(4*pi*x)/sqrt(4*pi), 0)
1609# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1610
1611# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1612 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1613# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1614 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1615# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1616
1617# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1618 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1619# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1620 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1621# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1622 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1623# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1624 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1625# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1626 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
1627# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1628 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
1629# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1630 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1631# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1632 ! Linear interpolation between r=0.08 and r=1.0
1633# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1634 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1635# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1636 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1637# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1638 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1639# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1640 else
1641# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1642 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
1643# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1644 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
1645# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1646 end if
1647# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1648
1649# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1650 ! case 252 is for the 2D MHD Rotor problem
1651# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1652 case (252) ! 2D MHD Rotor Problem
1653# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1654 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1655# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1656 !
1657# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1658 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
1659# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1660 ! velocity w=20, giving v_tan=2 at r=0.1
1661# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1662
1663# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1664 ! Calculate distance squared from the center
1665# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1666 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1667# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1668
1669# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1670 ! inner radius of 0.1
1671# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1672 if (r_sq <= 0.1**2) then
1673# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1674 ! -- Inside the rotor -- Set density uniformly to 10
1675# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1676 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
1677# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1678
1679# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1680 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1681# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1682 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1683# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1684 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1685# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1686
1687# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1688 ! taper width of 0.015
1689# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1690 else if (r_sq <= 0.115**2) then
1691# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1692 ! linearly smooth the function between r = 0.1 and 0.115
1693# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1694 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1695# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1696
1697# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1698 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1699# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1700 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1701# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1702 end if
1703# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1704 case (253) ! MHD Smooth Magnetic Vortex
1705# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1706 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1707# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1708 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1709# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1710
1711# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1712 ! velocity
1713# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1714 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1715# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1716 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1717# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1718
1719# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1720 ! magnetic field
1721# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1722 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1723# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1724 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1725# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1726
1727# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1728 ! pressure
1729# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1730 q_prim_vf(eqn_idx%E)%sf(i, j, &
1731# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1732 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
1733# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1734 case (260) ! Gaussian Divergence Pulse
1735# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1736 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1737# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1738 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1739# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1740 ! initialized to zero everywhere.
1741# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1742
1743# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1744 eps_mhd = patch_icpp(patch_id)%a(2)
1745# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1746 sigma = patch_icpp(patch_id)%a(3)
1747# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1748 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1749# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1750
1751# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1752 ! B-field
1753# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1754 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1755# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1756 case (261) ! Blob
1757# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1758 r0 = 1._wp/sqrt(8._wp)
1759# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1760 r2 = x_cc(i)**2 + y_cc(j)**2
1761# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1762 r = sqrt(r2)
1763# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1764 alpha = r/r0
1765# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1766 if (alpha < 1) then
1767# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1768 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
1769# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1770 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
1771# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1772 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1773# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1774 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
1775# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1776 end if
1777# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1778 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
1779# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1780 ! rotate by \alpha = atan(2)
1781# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1782 alpha = atan(2._wp)
1783# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1784 cosa = cos(alpha)
1785# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1786 sina = sin(alpha)
1787# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1788 ! projection along shock normal
1789# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1790 r = x_cc(i)*cosa + y_cc(j)*sina
1791# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1792
1793# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1794 if (r <= 0.5_wp) then
1795# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1796 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1797# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1798 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1799# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1800 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
1801# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1802 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
1803# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1804 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
1805# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1806 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1807# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1808 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1809# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1810 else
1811# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1812 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1813# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1814 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1815# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1816 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
1817# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1818 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
1819# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1820 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
1821# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1822 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1823# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1824 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1825# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1826 end if
1827# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1828 ! v^z and B^z remain zero by default
1829# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1830 case (270) ! 2D extrusion of 1D profile from external data
1831# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1832 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1833# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1834 if (.not. files_loaded) then
1835# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1836 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1837# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1838 do f = 1, max_files
1839# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1840 write (file_num_str, '(I0)') f
1841# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1842 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
1843# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1844 end do
1845# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1846
1847# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1848 ! Common file reading setup
1849# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1850 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1851# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1852 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
1853# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1854
1855# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1856 select case (num_dims)
1857# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1858 case (1, 2) ! 1D and 2D cases are similar
1859# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1860 ! Count lines
1861# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1862 line_count = 0
1863# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1864 do
1865# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1866 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1867# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1868 if (ios2 /= 0) exit
1869# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1870 line_count = line_count + 1
1871# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1872 end do
1873# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1874 close (unit2)
1875# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1876
1877# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1878 xrows = line_count
1879# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1880 yrows = 1
1881# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1882 index_x = 0
1883# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1884 if (num_dims == 2) index_x = i
1885# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1886#ifdef MFC_DEBUG
1887# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1888 block
1889# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1890 use iso_fortran_env, only: output_unit
1891# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1892
1893# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1894 print *, 'm_icpp_patches.fpp:274: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1895# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1896
1897# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1898 call flush (output_unit)
1899# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1900 end block
1901# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1902#endif
1903# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1904 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1905# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1906
1907# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1908
1909# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1910
1911# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1912#if defined(MFC_OpenACC)
1913# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1914!$acc enter data create(x_coords, stored_values)
1915# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1916#elif defined(MFC_OpenMP)
1917# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1918!$omp target enter data map(always,alloc:x_coords, stored_values)
1919# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1920#endif
1921# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1922
1923# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1924 ! Read data from all files
1925# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1926 do f = 1, max_files
1927# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1928 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1929# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1930 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
1931# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1932
1933# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1934 do iter = 1, xrows
1935# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1936 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
1937# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1938 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
1939# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1940 end do
1941# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1942 close (unit)
1943# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1944 end do
1945# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1946
1947# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1948 ! Calculate offsets
1949# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1950 domain_xstart = x_coords(1)
1951# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1952 x_step = x_cc(1) - x_cc(0)
1953# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1954 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
1955# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1956 global_offset_x = nint(abs(delta_x)/x_step)
1957# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1958 case (3) ! 3D case - determine grid structure
1959# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1960 ! Find yRows by counting rows with same x
1961# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1962 read (unit2, *, iostat=ios2) x0, y0, dummy_z
1963# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1964 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
1965# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1966
1967# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1968 yrows = 1
1969# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1970 do
1971# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1972 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1973# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1974 if (ios2 /= 0) exit
1975# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1976 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
1977# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1978 yrows = yrows + 1
1979# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1980 else
1981# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1982 exit
1983# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1984 end if
1985# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1986 end do
1987# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1988 close (unit2)
1989# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1990
1991# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1992 ! Count total rows
1993# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1994 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1995# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1996 nrows = 0
1997# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1998 do
1999# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2000 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2001# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2002 if (ios2 /= 0) exit
2003# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2004 nrows = nrows + 1
2005# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2006 end do
2007# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2008 close (unit2)
2009# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2010
2011# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2012 xrows = nrows/yrows
2013# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2014#ifdef MFC_DEBUG
2015# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2016 block
2017# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2018 use iso_fortran_env, only: output_unit
2019# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2020
2021# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2022 print *, 'm_icpp_patches.fpp:274: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2023# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2024
2025# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2026 call flush (output_unit)
2027# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2028 end block
2029# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2030#endif
2031# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2032 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2033# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2034
2035# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2036
2037# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2038
2039# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2040
2041# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2042#if defined(MFC_OpenACC)
2043# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2044!$acc enter data create(x_coords, y_coords, stored_values)
2045# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2046#elif defined(MFC_OpenMP)
2047# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2048!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2049# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2050#endif
2051# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2052 index_x = i
2053# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2054 index_y = j
2055# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2056
2057# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2058 ! Read all files
2059# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2060 do f = 1, max_files
2061# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2062 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2063# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2064 if (ios /= 0) then
2065# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2066 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2067# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2068 cycle
2069# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2070 end if
2071# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2072
2073# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2074 iter = 0
2075# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2076 do iix = 1, xrows
2077# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2078 do iiy = 1, yrows
2079# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2080 iter = iter + 1
2081# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2082 if (f == 1) then
2083# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2084 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2085# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2086 else
2087# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2088 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2089# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2090 end if
2091# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2092 if (ios /= 0) call s_mpi_abort("Error reading data")
2093# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2094 end do
2095# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2096 end do
2097# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2098 close (unit)
2099# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2100 end do
2101# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2102
2103# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2104 ! Calculate offsets
2105# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2106 x_step = x_cc(1) - x_cc(0)
2107# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2108 y_step = y_cc(1) - y_cc(0)
2109# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2110 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2111# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2112 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2113# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2114 global_offset_x = nint(abs(delta_x)/x_step)
2115# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2116 global_offset_y = nint(abs(delta_y)/y_step)
2117# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2118 end select
2119# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2120
2121# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2122 files_loaded = .true.
2123# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2124 end if
2125# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2126
2127# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2128 ! Data assignment
2129# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2130 select case (num_dims)
2131# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2132 case (1)
2133# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2134 idx = i + 1 + global_offset_x
2135# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2136 do f = 1, sys_size
2137# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2138 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2139# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2140 end do
2141# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2142 case (2)
2143# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2144 idx = i + 1 + global_offset_x - index_x
2145# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2146 do f = 1, sys_size - 1
2147# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2148 jump = merge(1, 0, f >= eqn_idx%mom%end)
2149# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2150 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2151# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2152 end do
2153# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2154 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2155# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2156 case (3)
2157# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2158 idx = i + 1 + global_offset_x - index_x
2159# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2160 idy = j + 1 + global_offset_y - index_y
2161# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2162 do f = 1, sys_size - 1
2163# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2164 jump = merge(1, 0, f >= eqn_idx%mom%end)
2165# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2166 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2167# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2168 end do
2169# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2170 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2171# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2172 end select
2173# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2174 case (280) ! Isentropic vortex
2175# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2176 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
2177# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2178 ! geometry 2
2179# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2180 if (patch_id == 1) then
2181# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2182 q_prim_vf(eqn_idx%E)%sf(i, j, &
2183# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2184 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
2185# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2186 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
2187# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2188 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2189# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2190 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
2191# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2192 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
2193# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2194 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2195# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2196 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
2197# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2198 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2199# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2200 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2201# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2202 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
2203# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2204 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2205# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2206 end if
2207# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2208 case (281) ! Acoustic pulse
2209# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2210 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
2211# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2212 ! geometry 2
2213# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2214 if (patch_id == 2) then
2215# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2216 q_prim_vf(eqn_idx%E)%sf(i, j, &
2217# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2218 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
2219# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2220 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2221# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2222 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
2223# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2224 end if
2225# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2226 case (282) ! Zero-circulation vortex
2227# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2228 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
2229# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2230 ! geometry 2
2231# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2232 if (patch_id == 2) then
2233# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2234 q_prim_vf(eqn_idx%E)%sf(i, j, &
2235# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2236 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
2237# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2238 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2239# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2240 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
2241# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2242 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2243# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2244 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2245# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2246 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2247# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2248 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2249# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2250 end if
2251# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2252 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
2253# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2254 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
2255# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2256 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
2257# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2258 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
2259# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2260 ! patch_icpp(patch_id)%epsilon; defaults to 5.
2261# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2262 if (patch_id == 1) then
2263# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2264 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
2265# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2266 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
2267# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2268 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
2269# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2270 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
2271# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2272 do igq = 1, 3
2273# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2274 do jgq = 1, 3
2275# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2276 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
2277# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2278 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
2279# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2280 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
2281# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2282 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
2283# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2284 wq = gauss_w(igq)*gauss_w(jgq)
2285# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2286 rhoq = t_facq**1.4_wp
2287# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2288 pq = t_facq**2.4_wp
2289# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2290 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2291# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2292 & - r2q)
2293# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2294 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2295# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2296 & - r2q)
2297# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2298 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
2299# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2300 rho_avg = rho_avg + wq*rhoq
2301# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2302 rhou_avg = rhou_avg + wq*(rhoq*uq)
2303# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2304 rhov_avg = rhov_avg + wq*(rhoq*vq)
2305# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2306 e_avg = e_avg + wq*eq
2307# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2308 end do
2309# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2310 end do
2311# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2312 rho_avg = rho_avg*0.25_wp
2313# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2314 rhou_avg = rhou_avg*0.25_wp
2315# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2316 rhov_avg = rhov_avg*0.25_wp
2317# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2318 e_avg = e_avg*0.25_wp
2319# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2320 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
2321# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2322 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
2323# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2324 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
2325# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2326 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
2327# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2328 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
2329# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2330 end if
2331# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2332 case (291) ! Isothermal Flat Plate
2333# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2334 t_inf = 1125.0_wp
2335# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2336 t_wall = 600.0_wp
2337# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2338 p_atm = 101325.0_wp
2339# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2340
2341# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2342 ! Boundary/Shear Layer thicknesses
2343# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2344 delta_th = 0.0003_wp ! Thermal BL thickness
2345# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2346 delta_shear = 8e-3_wp ! Velocity BL thickness
2347# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2348
2349# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2350 u_max = 50.0_wp ! Freestream Velocity (m/s)
2351# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2352
2353# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2354 mw_n2 = 28.0134e-3_wp
2355# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2356 mw_o2 = 31.999e-3_wp
2357# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2358 y_n2 = 0.767_wp
2359# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2360 y_o2 = 0.233_wp
2361# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2362 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
2363# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2364 bottom_blend_u = tanh(y_cc(j)/delta_shear)
2365# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2366 bottom_blend_t = tanh(y_cc(j)/delta_th)
2367# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2368 u_mean = u_max*bottom_blend_u
2369# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2370 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
2371# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2372 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
2373# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2374 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
2375# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2376 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2377# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2378 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
2379# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2380 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
2381# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2382 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
2383# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2384 case default
2385# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2386 if (proc_rank == 0) then
2387# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2388 call s_int_to_str(patch_id, istr)
2389# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2390 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
2391# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2392 end if
2393# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2394 end select
2395 end if
2396
2397 ! Updating the patch identities bookkeeping variable
2398 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2399 end if
2400 end do
2401 end do
2402 if (allocated(stored_values)) then
2403# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2404#ifdef MFC_DEBUG
2405# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2406 block
2407# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2408 use iso_fortran_env, only: output_unit
2409# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2410
2411# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2412 print *, 'm_icpp_patches.fpp:282: ', '@:DEALLOCATE(stored_values)'
2413# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2414
2415# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2416 call flush (output_unit)
2417# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2418 end block
2419# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2420#endif
2421# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2422
2423# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2424#if defined(MFC_OpenACC)
2425# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2426!$acc exit data delete(stored_values)
2427# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2428#elif defined(MFC_OpenMP)
2429# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2430!$omp target exit data map(release:stored_values)
2431# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2432#endif
2433# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2434 deallocate (stored_values)
2435# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2436#ifdef MFC_DEBUG
2437# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2438 block
2439# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2440 use iso_fortran_env, only: output_unit
2441# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2442
2443# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2444 print *, 'm_icpp_patches.fpp:282: ', '@:DEALLOCATE(x_coords)'
2445# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2446
2447# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2448 call flush (output_unit)
2449# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2450 end block
2451# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2452#endif
2453# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2454
2455# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2456#if defined(MFC_OpenACC)
2457# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2458!$acc exit data delete(x_coords)
2459# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2460#elif defined(MFC_OpenMP)
2461# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2462!$omp target exit data map(release:x_coords)
2463# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2464#endif
2465# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2466 deallocate (x_coords)
2467# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2468 end if
2469# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2470
2471# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2472 if (allocated(y_coords)) then
2473# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2474#ifdef MFC_DEBUG
2475# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2476 block
2477# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2478 use iso_fortran_env, only: output_unit
2479# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2480
2481# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2482 print *, 'm_icpp_patches.fpp:282: ', '@:DEALLOCATE(y_coords)'
2483# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2484
2485# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2486 call flush (output_unit)
2487# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2488 end block
2489# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2490#endif
2491# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2492
2493# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2494#if defined(MFC_OpenACC)
2495# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2496!$acc exit data delete(y_coords)
2497# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2498#elif defined(MFC_OpenMP)
2499# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2500!$omp target exit data map(release:y_coords)
2501# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2502#endif
2503# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2504 deallocate (y_coords)
2505# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2506 end if
2507
2508 end subroutine s_icpp_spiral
2509
2510 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
2511 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
2512 !! its boundary.
2513 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2514
2515 integer, intent(in) :: patch_id
2516
2517#ifdef MFC_MIXED_PRECISION
2518 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2519#else
2520 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2521#endif
2522 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2523 real(wp) :: radius
2524 integer :: i, j, k !< Generic loop iterators
2525
2526 integer :: xRows, yRows, nRows, iix, iiy, max_files
2527# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2528 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2529# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2530 real(wp) :: x_len, x_step, y_len, y_step
2531# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2532 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2533# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2534 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
2535# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2536 real(wp) :: delta_x, delta_y
2537# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2538 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
2539# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2540 character(len=200) :: errmsg
2541# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2542 real(wp), allocatable :: stored_values(:,:,:)
2543# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2544 real(wp), allocatable :: x_coords(:), y_coords(:)
2545# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2546 logical :: files_loaded = .false.
2547# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2548 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2549# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2550 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
2551# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2552 character(len=20) :: file_num_str !< For storing the file number as a string
2553# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2554 character(len=20) :: zeros_part !< For the trailing zeros part
2555# 302 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2556 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
2557 ! Place any declaration of intermediate variables here
2558# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2559 real(wp) :: eps, eps_mhd, C_mhd
2560# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2561 real(wp) :: r, rmax, gam, umax, p0
2562# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2563 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2564# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2565 real(wp) :: factor
2566# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2567 real(wp) :: r0, alpha, r2
2568# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2569 real(wp) :: sinA, cosA
2570# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2571 real(wp) :: r_sq
2572# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2573
2574# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2575 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
2576# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2577 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
2578# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2579 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
2580# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2581 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
2582# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2583 integer :: igq, jgq
2584# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2585
2586# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2587 ! # 291 - Shear/Thermal Layer Case
2588# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2589 real(wp) :: delta_shear, u_max, u_mean
2590# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2591 real(wp) :: T_wall, T_inf, P_atm, T_loc
2592# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2593 real(wp) :: delta_th, R_mix
2594# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2595 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
2596# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2597 real(wp) :: bottom_blend_u, bottom_blend_T
2598# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2599
2600# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2601 ! # 207
2602# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2603 real(wp) :: sigma, gauss1, gauss2
2604# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2605
2606# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2607 ! # 208
2608# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2609 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2610# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2611
2612# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2613 eps = 1.e-9_wp
2614
2615 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
2616
2617 x_centroid = patch_icpp(patch_id)%x_centroid
2618 y_centroid = patch_icpp(patch_id)%y_centroid
2619 radius = patch_icpp(patch_id)%radius
2620 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2621 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2622
2623 ! Initialize eta=1; modified if smoothing is enabled
2624 eta = 1._wp
2625
2626 ! Assign patch vars if cell is covered and patch has write permission
2627
2628 do j = 0, n
2629 do i = 0, m
2630 if (patch_icpp(patch_id)%smoothen) then
2631 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
2632 eta = tanh(smooth_coeff/min(dx, &
2633 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
2634 end if
2635
2636 if (((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2 <= radius**2 &
2637 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
2638 & 0) == smooth_patch_id) then
2639 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
2640
2641
2642 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2643 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2644# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2645 case (200) ! Two-fluid cubic interface
2646# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2647 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2648# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2649 ! Volume Fractions
2650# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2651 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
2652# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2653 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
2654# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2655 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
2656# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2657 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
2658# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2659 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
2660# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2661 end if
2662# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2663 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2664# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2665 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2666# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2667 rmax = 0.2_wp
2668# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2669
2670# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2671 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2672# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2673 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2674# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2675 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2676# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2677
2678# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2679 if (r < rmax) then
2680# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2681 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2682# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2683 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2684# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2685 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2686# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2687 else if (r < 2*rmax) then
2688# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2689 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2690# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2691 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2692# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2693 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
2694# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2695 else
2696# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2697 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2698# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2699 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2700# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2701 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2702# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2703 end if
2704# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2705 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2706# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2707 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2708# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2709 rmax = 0.2_wp
2710# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2711
2712# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2713 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2714# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2715 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2716# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2717 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2718# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2719
2720# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2721 if (r < rmax) then
2722# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2723 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2724# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2725 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2726# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2727 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2728# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2729 else if (r < 2*rmax) then
2730# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2731 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2732# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2733 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2734# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2735 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
2736# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2737 else
2738# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2739 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2740# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2741 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2742# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2743 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2744# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2745 end if
2746# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2747
2748# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2749 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
2750# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2751 case (204) ! Rayleigh-Taylor instability
2752# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2753 rhoh = 3._wp
2754# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2755 rhol = 1._wp
2756# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2757 pref = 1.e5_wp
2758# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2759 pint = pref
2760# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2761 h = 0.7_wp
2762# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2763 lam = 0.2_wp
2764# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2765 wl = 2._wp*pi/lam
2766# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2767 amp = 0.05_wp/wl
2768# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2769
2770# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2771 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2772# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2773
2774# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2775 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2776# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2777
2778# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2779 if (alph < eps) alph = eps
2780# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2781 if (alph > 1._wp - eps) alph = 1._wp - eps
2782# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2783
2784# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2785 if (y_cc(j) > inth) then
2786# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2787 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2788# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2789 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2790# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2791 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2792# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2793 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2794# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2795 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2796# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2797 else
2798# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2799 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2800# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2801 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2802# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2803 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2804# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2805 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2806# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2807 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2808# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2809 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2810# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2811 end if
2812# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2813 case (205) ! 2D lung wave interaction problem
2814# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2815 h = 0.0_wp ! non dim origin y
2816# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2817 lam = 1.0_wp ! non dim lambda
2818# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2819 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
2820# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2821
2822# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2823 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2824# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2825
2826# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2827 if (y_cc(j) > inth) then
2828# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2829 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2830# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2831 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2832# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2833 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2834# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2835 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2836# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2837 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2838# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2839 end if
2840# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2841 case (206) ! 2D lung wave interaction problem - horizontal domain
2842# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2843 h = 0.0_wp ! non dim origin y
2844# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2845 lam = 1.0_wp ! non dim lambda
2846# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2847 amp = patch_icpp(patch_id)%a(2)
2848# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2849
2850# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2851 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2852# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2853
2854# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2855 if (x_cc(i) > intl) then ! this is the liquid
2856# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2857 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2858# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2859 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2860# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2861 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2862# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2863 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2864# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2865 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2866# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2867 end if
2868# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2869 case (207) ! Kelvin Helmholtz Instability
2870# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2871 sigma = 0.05_wp/sqrt(2.0_wp)
2872# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2873 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2874# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2875 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2876# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2877 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
2878# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2879 case (208) ! Richtmeyer Meshkov Instability
2880# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2881 lam = 1.0_wp
2882# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2883 eps = 1.0e-6_wp
2884# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2885 ei = 5.0_wp
2886# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2887 ! Smoothening function to smooth out sharp discontinuity in the interface
2888# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2889 if (x_cc(i) <= 0.7_wp*lam) then
2890# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2891 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2892# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2893 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2894# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2895 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2896# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2897 alpha_sf6 = 1.0_wp - alpha_air
2898# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2899 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
2900# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2901 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
2902# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2903 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
2904# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2905 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
2906# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2907 end if
2908# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2909 case (250) ! MHD Orszag-Tang vortex
2910# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2911 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
2912# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2913 ! sin(4*pi*x)/sqrt(4*pi), 0)
2914# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2915
2916# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2917 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2918# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2919 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2920# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2921
2922# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2923 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2924# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2925 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2926# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2927 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2928# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2929 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2930# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2931 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
2932# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2933 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
2934# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2935 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2936# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2937 ! Linear interpolation between r=0.08 and r=1.0
2938# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2939 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2940# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2941 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2942# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2943 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2944# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2945 else
2946# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2947 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
2948# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2949 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
2950# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2951 end if
2952# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2953
2954# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2955 ! case 252 is for the 2D MHD Rotor problem
2956# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2957 case (252) ! 2D MHD Rotor Problem
2958# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2959 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
2960# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2961 !
2962# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2963 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
2964# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2965 ! velocity w=20, giving v_tan=2 at r=0.1
2966# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2967
2968# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2969 ! Calculate distance squared from the center
2970# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2971 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2972# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2973
2974# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2975 ! inner radius of 0.1
2976# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2977 if (r_sq <= 0.1**2) then
2978# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2979 ! -- Inside the rotor -- Set density uniformly to 10
2980# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2981 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
2982# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2983
2984# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2985 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
2986# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2987 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2988# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2989 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2990# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2991
2992# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2993 ! taper width of 0.015
2994# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2995 else if (r_sq <= 0.115**2) then
2996# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2997 ! linearly smooth the function between r = 0.1 and 0.115
2998# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2999 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3000# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3001
3002# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3003 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3004# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3005 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3006# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3007 end if
3008# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3009 case (253) ! MHD Smooth Magnetic Vortex
3010# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3011 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
3012# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3013 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
3014# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3015
3016# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3017 ! velocity
3018# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3019 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3020# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3021 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3022# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3023
3024# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3025 ! magnetic field
3026# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3027 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3028# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3029 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3030# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3031
3032# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3033 ! pressure
3034# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3035 q_prim_vf(eqn_idx%E)%sf(i, j, &
3036# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3037 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
3038# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3039 case (260) ! Gaussian Divergence Pulse
3040# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3041 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
3042# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3043 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
3044# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3045 ! initialized to zero everywhere.
3046# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3047
3048# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3049 eps_mhd = patch_icpp(patch_id)%a(2)
3050# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3051 sigma = patch_icpp(patch_id)%a(3)
3052# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3053 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3054# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3055
3056# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3057 ! B-field
3058# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3059 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3060# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3061 case (261) ! Blob
3062# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3063 r0 = 1._wp/sqrt(8._wp)
3064# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3065 r2 = x_cc(i)**2 + y_cc(j)**2
3066# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3067 r = sqrt(r2)
3068# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3069 alpha = r/r0
3070# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3071 if (alpha < 1) then
3072# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3073 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
3074# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3075 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
3076# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3077 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
3078# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3079 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
3080# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3081 end if
3082# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3083 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
3084# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3085 ! rotate by \alpha = atan(2)
3086# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3087 alpha = atan(2._wp)
3088# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3089 cosa = cos(alpha)
3090# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3091 sina = sin(alpha)
3092# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3093 ! projection along shock normal
3094# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3095 r = x_cc(i)*cosa + y_cc(j)*sina
3096# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3097
3098# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3099 if (r <= 0.5_wp) then
3100# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3101 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
3102# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3103 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3104# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3105 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
3106# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3107 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
3108# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3109 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
3110# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3111 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
3112# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3113 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
3114# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3115 else
3116# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3117 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
3118# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3119 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3120# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3121 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
3122# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3123 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
3124# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3125 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
3126# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3127 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
3128# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3129 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
3130# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3131 end if
3132# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3133 ! v^z and B^z remain zero by default
3134# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3135 case (270) ! 2D extrusion of 1D profile from external data
3136# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3137 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
3138# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3139 if (.not. files_loaded) then
3140# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3141 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3142# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3143 do f = 1, max_files
3144# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3145 write (file_num_str, '(I0)') f
3146# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3147 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
3148# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3149 end do
3150# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3151
3152# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3153 ! Common file reading setup
3154# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3155 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3156# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3157 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3158# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3159
3160# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3161 select case (num_dims)
3162# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3163 case (1, 2) ! 1D and 2D cases are similar
3164# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3165 ! Count lines
3166# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3167 line_count = 0
3168# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3169 do
3170# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3171 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3172# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3173 if (ios2 /= 0) exit
3174# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3175 line_count = line_count + 1
3176# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3177 end do
3178# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3179 close (unit2)
3180# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3181
3182# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3183 xrows = line_count
3184# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3185 yrows = 1
3186# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3187 index_x = 0
3188# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3189 if (num_dims == 2) index_x = i
3190# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3191#ifdef MFC_DEBUG
3192# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3193 block
3194# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3195 use iso_fortran_env, only: output_unit
3196# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3197
3198# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3199 print *, 'm_icpp_patches.fpp:333: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3200# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3201
3202# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3203 call flush (output_unit)
3204# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3205 end block
3206# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3207#endif
3208# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3209 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3210# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3211
3212# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3213
3214# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3215
3216# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3217#if defined(MFC_OpenACC)
3218# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3219!$acc enter data create(x_coords, stored_values)
3220# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3221#elif defined(MFC_OpenMP)
3222# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3223!$omp target enter data map(always,alloc:x_coords, stored_values)
3224# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3225#endif
3226# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3227
3228# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3229 ! Read data from all files
3230# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3231 do f = 1, max_files
3232# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3233 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3234# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3235 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3236# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3237
3238# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3239 do iter = 1, xrows
3240# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3241 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3242# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3243 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3244# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3245 end do
3246# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3247 close (unit)
3248# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3249 end do
3250# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3251
3252# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3253 ! Calculate offsets
3254# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3255 domain_xstart = x_coords(1)
3256# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3257 x_step = x_cc(1) - x_cc(0)
3258# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3259 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
3260# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3261 global_offset_x = nint(abs(delta_x)/x_step)
3262# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3263 case (3) ! 3D case - determine grid structure
3264# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3265 ! Find yRows by counting rows with same x
3266# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3267 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3268# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3269 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3270# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3271
3272# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3273 yrows = 1
3274# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3275 do
3276# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3277 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3278# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3279 if (ios2 /= 0) exit
3280# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3281 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3282# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3283 yrows = yrows + 1
3284# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3285 else
3286# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3287 exit
3288# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3289 end if
3290# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3291 end do
3292# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3293 close (unit2)
3294# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3295
3296# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3297 ! Count total rows
3298# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3299 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3300# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3301 nrows = 0
3302# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3303 do
3304# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3305 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3306# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3307 if (ios2 /= 0) exit
3308# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3309 nrows = nrows + 1
3310# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3311 end do
3312# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3313 close (unit2)
3314# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3315
3316# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3317 xrows = nrows/yrows
3318# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3319#ifdef MFC_DEBUG
3320# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3321 block
3322# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3323 use iso_fortran_env, only: output_unit
3324# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3325
3326# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3327 print *, 'm_icpp_patches.fpp:333: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3328# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3329
3330# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3331 call flush (output_unit)
3332# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3333 end block
3334# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3335#endif
3336# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3337 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3338# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3339
3340# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3341
3342# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3343
3344# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3345
3346# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3347#if defined(MFC_OpenACC)
3348# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3349!$acc enter data create(x_coords, y_coords, stored_values)
3350# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3351#elif defined(MFC_OpenMP)
3352# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3353!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3354# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3355#endif
3356# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3357 index_x = i
3358# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3359 index_y = j
3360# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3361
3362# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3363 ! Read all files
3364# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3365 do f = 1, max_files
3366# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3367 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3368# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3369 if (ios /= 0) then
3370# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3371 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3372# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3373 cycle
3374# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3375 end if
3376# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3377
3378# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3379 iter = 0
3380# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3381 do iix = 1, xrows
3382# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3383 do iiy = 1, yrows
3384# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3385 iter = iter + 1
3386# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3387 if (f == 1) then
3388# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3389 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3390# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3391 else
3392# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3393 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3394# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3395 end if
3396# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3397 if (ios /= 0) call s_mpi_abort("Error reading data")
3398# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3399 end do
3400# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3401 end do
3402# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3403 close (unit)
3404# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3405 end do
3406# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3407
3408# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3409 ! Calculate offsets
3410# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3411 x_step = x_cc(1) - x_cc(0)
3412# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3413 y_step = y_cc(1) - y_cc(0)
3414# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3415 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3416# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3417 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3418# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3419 global_offset_x = nint(abs(delta_x)/x_step)
3420# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3421 global_offset_y = nint(abs(delta_y)/y_step)
3422# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3423 end select
3424# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3425
3426# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3427 files_loaded = .true.
3428# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3429 end if
3430# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3431
3432# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3433 ! Data assignment
3434# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3435 select case (num_dims)
3436# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3437 case (1)
3438# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3439 idx = i + 1 + global_offset_x
3440# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3441 do f = 1, sys_size
3442# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3443 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3444# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3445 end do
3446# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3447 case (2)
3448# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3449 idx = i + 1 + global_offset_x - index_x
3450# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3451 do f = 1, sys_size - 1
3452# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3453 jump = merge(1, 0, f >= eqn_idx%mom%end)
3454# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3455 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3456# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3457 end do
3458# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3459 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3460# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3461 case (3)
3462# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3463 idx = i + 1 + global_offset_x - index_x
3464# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3465 idy = j + 1 + global_offset_y - index_y
3466# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3467 do f = 1, sys_size - 1
3468# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3469 jump = merge(1, 0, f >= eqn_idx%mom%end)
3470# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3471 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3472# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3473 end do
3474# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3475 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3476# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3477 end select
3478# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3479 case (280) ! Isentropic vortex
3480# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3481 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3482# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3483 ! geometry 2
3484# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3485 if (patch_id == 1) then
3486# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3487 q_prim_vf(eqn_idx%E)%sf(i, j, &
3488# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3489 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
3490# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3491 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3492# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3493 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3494# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3495 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
3496# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3497 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3498# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3499 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3500# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3501 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
3502# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3503 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3504# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3505 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3506# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3507 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
3508# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3509 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3510# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3511 end if
3512# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3513 case (281) ! Acoustic pulse
3514# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3515 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3516# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3517 ! geometry 2
3518# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3519 if (patch_id == 2) then
3520# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3521 q_prim_vf(eqn_idx%E)%sf(i, j, &
3522# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3523 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
3524# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3525 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3526# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3527 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
3528# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3529 end if
3530# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3531 case (282) ! Zero-circulation vortex
3532# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3533 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
3534# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3535 ! geometry 2
3536# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3537 if (patch_id == 2) then
3538# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3539 q_prim_vf(eqn_idx%E)%sf(i, j, &
3540# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3541 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
3542# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3543 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3544# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3545 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
3546# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3547 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3548# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3549 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3550# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3551 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3552# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3553 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3554# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3555 end if
3556# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3557 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
3558# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3559 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
3560# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3561 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
3562# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3563 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
3564# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3565 ! patch_icpp(patch_id)%epsilon; defaults to 5.
3566# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3567 if (patch_id == 1) then
3568# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3569 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
3570# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3571 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
3572# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3573 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
3574# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3575 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
3576# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3577 do igq = 1, 3
3578# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3579 do jgq = 1, 3
3580# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3581 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
3582# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3583 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
3584# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3585 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
3586# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3587 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
3588# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3589 wq = gauss_w(igq)*gauss_w(jgq)
3590# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3591 rhoq = t_facq**1.4_wp
3592# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3593 pq = t_facq**2.4_wp
3594# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3595 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3596# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3597 & - r2q)
3598# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3599 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3600# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3601 & - r2q)
3602# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3603 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
3604# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3605 rho_avg = rho_avg + wq*rhoq
3606# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3607 rhou_avg = rhou_avg + wq*(rhoq*uq)
3608# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3609 rhov_avg = rhov_avg + wq*(rhoq*vq)
3610# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3611 e_avg = e_avg + wq*eq
3612# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3613 end do
3614# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3615 end do
3616# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3617 rho_avg = rho_avg*0.25_wp
3618# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3619 rhou_avg = rhou_avg*0.25_wp
3620# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3621 rhov_avg = rhov_avg*0.25_wp
3622# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3623 e_avg = e_avg*0.25_wp
3624# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3625 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
3626# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3627 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
3628# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3629 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
3630# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3631 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
3632# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3633 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
3634# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3635 end if
3636# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3637 case (291) ! Isothermal Flat Plate
3638# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3639 t_inf = 1125.0_wp
3640# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3641 t_wall = 600.0_wp
3642# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3643 p_atm = 101325.0_wp
3644# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3645
3646# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3647 ! Boundary/Shear Layer thicknesses
3648# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3649 delta_th = 0.0003_wp ! Thermal BL thickness
3650# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3651 delta_shear = 8e-3_wp ! Velocity BL thickness
3652# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3653
3654# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3655 u_max = 50.0_wp ! Freestream Velocity (m/s)
3656# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3657
3658# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3659 mw_n2 = 28.0134e-3_wp
3660# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3661 mw_o2 = 31.999e-3_wp
3662# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3663 y_n2 = 0.767_wp
3664# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3665 y_o2 = 0.233_wp
3666# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3667 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
3668# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3669 bottom_blend_u = tanh(y_cc(j)/delta_shear)
3670# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3671 bottom_blend_t = tanh(y_cc(j)/delta_th)
3672# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3673 u_mean = u_max*bottom_blend_u
3674# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3675 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
3676# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3677 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
3678# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3679 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
3680# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3681 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3682# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3683 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
3684# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3685 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
3686# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3687 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
3688# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3689 case default
3690# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3691 if (proc_rank == 0) then
3692# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3693 call s_int_to_str(patch_id, istr)
3694# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3695 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
3696# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3697 end if
3698# 333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3699 end select
3700 end if
3701 end if
3702 end do
3703 end do
3704 if (allocated(stored_values)) then
3705# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3706#ifdef MFC_DEBUG
3707# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3708 block
3709# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3710 use iso_fortran_env, only: output_unit
3711# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3712
3713# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3714 print *, 'm_icpp_patches.fpp:338: ', '@:DEALLOCATE(stored_values)'
3715# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3716
3717# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3718 call flush (output_unit)
3719# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3720 end block
3721# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3722#endif
3723# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3724
3725# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3726#if defined(MFC_OpenACC)
3727# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3728!$acc exit data delete(stored_values)
3729# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3730#elif defined(MFC_OpenMP)
3731# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3732!$omp target exit data map(release:stored_values)
3733# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3734#endif
3735# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3736 deallocate (stored_values)
3737# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3738#ifdef MFC_DEBUG
3739# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3740 block
3741# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3742 use iso_fortran_env, only: output_unit
3743# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3744
3745# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3746 print *, 'm_icpp_patches.fpp:338: ', '@:DEALLOCATE(x_coords)'
3747# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3748
3749# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3750 call flush (output_unit)
3751# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3752 end block
3753# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3754#endif
3755# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3756
3757# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3758#if defined(MFC_OpenACC)
3759# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3760!$acc exit data delete(x_coords)
3761# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3762#elif defined(MFC_OpenMP)
3763# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3764!$omp target exit data map(release:x_coords)
3765# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3766#endif
3767# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3768 deallocate (x_coords)
3769# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3770 end if
3771# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3772
3773# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3774 if (allocated(y_coords)) then
3775# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3776#ifdef MFC_DEBUG
3777# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3778 block
3779# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3780 use iso_fortran_env, only: output_unit
3781# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3782
3783# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3784 print *, 'm_icpp_patches.fpp:338: ', '@:DEALLOCATE(y_coords)'
3785# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3786
3787# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3788 call flush (output_unit)
3789# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3790 end block
3791# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3792#endif
3793# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3794
3795# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3796#if defined(MFC_OpenACC)
3797# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3798!$acc exit data delete(y_coords)
3799# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3800#elif defined(MFC_OpenMP)
3801# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3802!$omp target exit data map(release:y_coords)
3803# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3804#endif
3805# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3806 deallocate (y_coords)
3807# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3808 end if
3809
3810 end subroutine s_icpp_circle
3811
3812 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
3813 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3814
3815 ! Patch identifier
3816 integer, intent(in) :: patch_id
3817
3818#ifdef MFC_MIXED_PRECISION
3819 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3820#else
3821 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3822#endif
3823 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3824
3825 ! Generic loop iterators
3826 integer :: i, j, k
3827 real(wp) :: radius, myr, thickness
3828
3829 integer :: xRows, yRows, nRows, iix, iiy, max_files
3830# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3831 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3832# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3833 real(wp) :: x_len, x_step, y_len, y_step
3834# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3835 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3836# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3837 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
3838# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3839 real(wp) :: delta_x, delta_y
3840# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3841 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
3842# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3843 character(len=200) :: errmsg
3844# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3845 real(wp), allocatable :: stored_values(:,:,:)
3846# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3847 real(wp), allocatable :: x_coords(:), y_coords(:)
3848# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3849 logical :: files_loaded = .false.
3850# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3851 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3852# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3853 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
3854# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 character(len=20) :: file_num_str !< For storing the file number as a string
3856# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857 character(len=20) :: zeros_part !< For the trailing zeros part
3858# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
3860 ! Place any declaration of intermediate variables here
3861# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3862 real(wp) :: eps, eps_mhd, C_mhd
3863# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3864 real(wp) :: r, rmax, gam, umax, p0
3865# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3866 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3867# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3868 real(wp) :: factor
3869# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3870 real(wp) :: r0, alpha, r2
3871# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3872 real(wp) :: sinA, cosA
3873# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3874 real(wp) :: r_sq
3875# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3876
3877# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3878 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
3879# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3880 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
3881# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3882 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
3883# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3884 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
3885# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3886 integer :: igq, jgq
3887# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3888
3889# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3890 ! # 291 - Shear/Thermal Layer Case
3891# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3892 real(wp) :: delta_shear, u_max, u_mean
3893# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3894 real(wp) :: T_wall, T_inf, P_atm, T_loc
3895# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3896 real(wp) :: delta_th, R_mix
3897# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3898 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
3899# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3900 real(wp) :: bottom_blend_u, bottom_blend_T
3901# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3902
3903# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3904 ! # 207
3905# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3906 real(wp) :: sigma, gauss1, gauss2
3907# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3908
3909# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3910 ! # 208
3911# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3912 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3913# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3914
3915# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3916 eps = 1.e-9_wp
3917
3918 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
3919 x_centroid = patch_icpp(patch_id)%x_centroid
3920 y_centroid = patch_icpp(patch_id)%y_centroid
3921 radius = patch_icpp(patch_id)%radius
3922 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3923 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3924 thickness = patch_icpp(patch_id)%epsilon
3925
3926 ! Initialize eta=1; modified if smoothing is enabled
3927 eta = 1._wp
3928
3929 ! Assign patch vars if cell is covered and patch has write permission
3930 do j = 0, n
3931 do i = 0, m
3932 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
3933
3934 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
3935 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
3936 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
3937
3938
3939 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3940 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3941# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3942 case (200) ! Two-fluid cubic interface
3943# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3944 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3945# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3946 ! Volume Fractions
3947# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3948 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
3949# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3950 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
3951# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3952 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
3953# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3954 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
3955# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3956 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
3957# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3958 end if
3959# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3960 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3961# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3962 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3963# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3964 rmax = 0.2_wp
3965# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3966
3967# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3968 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3969# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3970 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3971# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3972 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3973# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3974
3975# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3976 if (r < rmax) then
3977# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3978 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3979# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3980 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3981# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3982 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3983# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3984 else if (r < 2*rmax) then
3985# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3986 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3987# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3988 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3989# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3990 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
3991# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3992 else
3993# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3994 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
3995# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3996 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
3997# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3998 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
3999# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4000 end if
4001# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4002 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
4003# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4004 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4005# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4006 rmax = 0.2_wp
4007# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4008
4009# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4010 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4011# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4012 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4013# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4014 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4015# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4016
4017# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4018 if (r < rmax) then
4019# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4020 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4021# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4022 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4023# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4024 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4025# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4026 else if (r < 2*rmax) then
4027# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4028 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4029# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4030 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4031# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4032 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
4033# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4034 else
4035# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4036 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4037# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4038 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4039# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4040 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
4041# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4042 end if
4043# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4044
4045# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4046 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
4047# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4048 case (204) ! Rayleigh-Taylor instability
4049# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4050 rhoh = 3._wp
4051# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4052 rhol = 1._wp
4053# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4054 pref = 1.e5_wp
4055# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4056 pint = pref
4057# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4058 h = 0.7_wp
4059# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4060 lam = 0.2_wp
4061# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4062 wl = 2._wp*pi/lam
4063# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4064 amp = 0.05_wp/wl
4065# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4066
4067# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4068 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
4069# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4070
4071# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4072 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4073# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4074
4075# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4076 if (alph < eps) alph = eps
4077# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4078 if (alph > 1._wp - eps) alph = 1._wp - eps
4079# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4080
4081# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4082 if (y_cc(j) > inth) then
4083# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4084 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4085# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4086 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4087# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4088 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4089# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4090 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4091# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4092 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4093# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4094 else
4095# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4096 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4097# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4098 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4099# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4100 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4101# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4102 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4103# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4104 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4105# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4106 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
4107# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4108 end if
4109# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4110 case (205) ! 2D lung wave interaction problem
4111# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4112 h = 0.0_wp ! non dim origin y
4113# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4114 lam = 1.0_wp ! non dim lambda
4115# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4116 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
4117# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4118
4119# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4120 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
4121# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4122
4123# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4124 if (y_cc(j) > inth) then
4125# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4126 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4127# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4128 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4129# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4130 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4131# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4132 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4133# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4134 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4135# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4136 end if
4137# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4138 case (206) ! 2D lung wave interaction problem - horizontal domain
4139# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4140 h = 0.0_wp ! non dim origin y
4141# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4142 lam = 1.0_wp ! non dim lambda
4143# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4144 amp = patch_icpp(patch_id)%a(2)
4145# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4146
4147# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4148 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4149# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4150
4151# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4152 if (x_cc(i) > intl) then ! this is the liquid
4153# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4154 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4155# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4156 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4157# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4158 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4159# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4160 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4161# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4162 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4163# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4164 end if
4165# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4166 case (207) ! Kelvin Helmholtz Instability
4167# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4168 sigma = 0.05_wp/sqrt(2.0_wp)
4169# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4170 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4171# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4172 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4173# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4174 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
4175# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4176 case (208) ! Richtmeyer Meshkov Instability
4177# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4178 lam = 1.0_wp
4179# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4180 eps = 1.0e-6_wp
4181# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4182 ei = 5.0_wp
4183# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4184 ! Smoothening function to smooth out sharp discontinuity in the interface
4185# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4186 if (x_cc(i) <= 0.7_wp*lam) then
4187# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4188 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4189# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4190 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
4191# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4192 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4193# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4194 alpha_sf6 = 1.0_wp - alpha_air
4195# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4196 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
4197# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4198 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
4199# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4200 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
4201# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4202 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
4203# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4204 end if
4205# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4206 case (250) ! MHD Orszag-Tang vortex
4207# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4208 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
4209# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4210 ! sin(4*pi*x)/sqrt(4*pi), 0)
4211# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4212
4213# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4214 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4215# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4216 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4217# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4218
4219# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4220 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4221# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4222 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4223# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4224 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4225# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4226 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4227# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4228 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
4229# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4230 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
4231# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4232 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4233# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4234 ! Linear interpolation between r=0.08 and r=1.0
4235# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4236 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4237# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4238 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4239# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4240 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4241# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4242 else
4243# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4244 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
4245# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4246 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
4247# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4248 end if
4249# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4250
4251# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4252 ! case 252 is for the 2D MHD Rotor problem
4253# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4254 case (252) ! 2D MHD Rotor Problem
4255# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4256 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
4257# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4258 !
4259# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4260 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
4261# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4262 ! velocity w=20, giving v_tan=2 at r=0.1
4263# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4264
4265# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4266 ! Calculate distance squared from the center
4267# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4268 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4269# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4270
4271# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4272 ! inner radius of 0.1
4273# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4274 if (r_sq <= 0.1**2) then
4275# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4276 ! -- Inside the rotor -- Set density uniformly to 10
4277# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4278 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
4279# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4280
4281# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4282 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
4283# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4284 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4285# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4286 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4287# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4288
4289# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4290 ! taper width of 0.015
4291# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4292 else if (r_sq <= 0.115**2) then
4293# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4294 ! linearly smooth the function between r = 0.1 and 0.115
4295# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4296 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4297# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4298
4299# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4300 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4301# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4302 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4303# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4304 end if
4305# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4306 case (253) ! MHD Smooth Magnetic Vortex
4307# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4308 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
4309# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4310 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4311# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4312
4313# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4314 ! velocity
4315# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4316 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4317# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4318 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4319# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4320
4321# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4322 ! magnetic field
4323# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4324 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4325# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4326 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4327# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4328
4329# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4330 ! pressure
4331# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4332 q_prim_vf(eqn_idx%E)%sf(i, j, &
4333# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4334 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
4335# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4336 case (260) ! Gaussian Divergence Pulse
4337# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4338 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
4339# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4340 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
4341# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4342 ! initialized to zero everywhere.
4343# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4344
4345# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4346 eps_mhd = patch_icpp(patch_id)%a(2)
4347# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4348 sigma = patch_icpp(patch_id)%a(3)
4349# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4350 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4351# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4352
4353# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4354 ! B-field
4355# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4356 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4357# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4358 case (261) ! Blob
4359# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4360 r0 = 1._wp/sqrt(8._wp)
4361# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4362 r2 = x_cc(i)**2 + y_cc(j)**2
4363# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4364 r = sqrt(r2)
4365# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4366 alpha = r/r0
4367# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4368 if (alpha < 1) then
4369# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4370 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
4371# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4372 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
4373# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4374 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4375# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4376 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
4377# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4378 end if
4379# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4380 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
4381# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4382 ! rotate by \alpha = atan(2)
4383# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4384 alpha = atan(2._wp)
4385# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4386 cosa = cos(alpha)
4387# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4388 sina = sin(alpha)
4389# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4390 ! projection along shock normal
4391# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4392 r = x_cc(i)*cosa + y_cc(j)*sina
4393# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4394
4395# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4396 if (r <= 0.5_wp) then
4397# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4398 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4399# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4400 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4401# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4402 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
4403# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4404 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
4405# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4406 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
4407# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4408 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4409# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4410 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4411# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4412 else
4413# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4414 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4415# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4416 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4417# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4418 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
4419# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4420 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
4421# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4422 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
4423# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4424 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4425# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4426 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4427# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4428 end if
4429# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4430 ! v^z and B^z remain zero by default
4431# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4432 case (270) ! 2D extrusion of 1D profile from external data
4433# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4434 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4435# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4436 if (.not. files_loaded) then
4437# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4438 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4439# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4440 do f = 1, max_files
4441# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4442 write (file_num_str, '(I0)') f
4443# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4444 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
4445# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4446 end do
4447# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4448
4449# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4450 ! Common file reading setup
4451# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4452 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4453# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4454 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
4455# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4456
4457# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4458 select case (num_dims)
4459# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4460 case (1, 2) ! 1D and 2D cases are similar
4461# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4462 ! Count lines
4463# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4464 line_count = 0
4465# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4466 do
4467# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4468 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4469# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4470 if (ios2 /= 0) exit
4471# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4472 line_count = line_count + 1
4473# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4474 end do
4475# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4476 close (unit2)
4477# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4478
4479# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4480 xrows = line_count
4481# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4482 yrows = 1
4483# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4484 index_x = 0
4485# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4486 if (num_dims == 2) index_x = i
4487# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4488#ifdef MFC_DEBUG
4489# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4490 block
4491# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4492 use iso_fortran_env, only: output_unit
4493# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4494
4495# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4496 print *, 'm_icpp_patches.fpp:384: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4497# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4498
4499# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4500 call flush (output_unit)
4501# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4502 end block
4503# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4504#endif
4505# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4506 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4507# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4508
4509# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4510
4511# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4512
4513# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4514#if defined(MFC_OpenACC)
4515# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4516!$acc enter data create(x_coords, stored_values)
4517# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4518#elif defined(MFC_OpenMP)
4519# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4520!$omp target enter data map(always,alloc:x_coords, stored_values)
4521# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4522#endif
4523# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4524
4525# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4526 ! Read data from all files
4527# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4528 do f = 1, max_files
4529# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4530 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4531# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4532 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4533# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4534
4535# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4536 do iter = 1, xrows
4537# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4538 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4539# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4540 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
4541# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4542 end do
4543# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4544 close (unit)
4545# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4546 end do
4547# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4548
4549# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4550 ! Calculate offsets
4551# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4552 domain_xstart = x_coords(1)
4553# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4554 x_step = x_cc(1) - x_cc(0)
4555# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4556 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
4557# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4558 global_offset_x = nint(abs(delta_x)/x_step)
4559# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4560 case (3) ! 3D case - determine grid structure
4561# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4562 ! Find yRows by counting rows with same x
4563# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4564 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4565# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4566 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4567# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4568
4569# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4570 yrows = 1
4571# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4572 do
4573# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4574 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4575# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4576 if (ios2 /= 0) exit
4577# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4578 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
4579# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4580 yrows = yrows + 1
4581# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4582 else
4583# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4584 exit
4585# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4586 end if
4587# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4588 end do
4589# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4590 close (unit2)
4591# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4592
4593# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4594 ! Count total rows
4595# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4596 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4597# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4598 nrows = 0
4599# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4600 do
4601# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4602 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4603# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4604 if (ios2 /= 0) exit
4605# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4606 nrows = nrows + 1
4607# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4608 end do
4609# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4610 close (unit2)
4611# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4612
4613# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4614 xrows = nrows/yrows
4615# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4616#ifdef MFC_DEBUG
4617# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4618 block
4619# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4620 use iso_fortran_env, only: output_unit
4621# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4622
4623# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4624 print *, 'm_icpp_patches.fpp:384: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4625# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4626
4627# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4628 call flush (output_unit)
4629# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4630 end block
4631# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4632#endif
4633# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4634 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4635# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4636
4637# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4638
4639# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4640
4641# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4642
4643# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4644#if defined(MFC_OpenACC)
4645# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4646!$acc enter data create(x_coords, y_coords, stored_values)
4647# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4648#elif defined(MFC_OpenMP)
4649# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4650!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4651# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4652#endif
4653# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4654 index_x = i
4655# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4656 index_y = j
4657# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4658
4659# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4660 ! Read all files
4661# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4662 do f = 1, max_files
4663# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4664 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4665# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4666 if (ios /= 0) then
4667# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4668 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4669# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4670 cycle
4671# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4672 end if
4673# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4674
4675# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4676 iter = 0
4677# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4678 do iix = 1, xrows
4679# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4680 do iiy = 1, yrows
4681# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4682 iter = iter + 1
4683# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4684 if (f == 1) then
4685# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4686 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4687# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4688 else
4689# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4690 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4691# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4692 end if
4693# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4694 if (ios /= 0) call s_mpi_abort("Error reading data")
4695# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4696 end do
4697# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4698 end do
4699# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4700 close (unit)
4701# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4702 end do
4703# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4704
4705# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4706 ! Calculate offsets
4707# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4708 x_step = x_cc(1) - x_cc(0)
4709# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4710 y_step = y_cc(1) - y_cc(0)
4711# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4712 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4713# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4714 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4715# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4716 global_offset_x = nint(abs(delta_x)/x_step)
4717# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4718 global_offset_y = nint(abs(delta_y)/y_step)
4719# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4720 end select
4721# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4722
4723# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4724 files_loaded = .true.
4725# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4726 end if
4727# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4728
4729# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4730 ! Data assignment
4731# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4732 select case (num_dims)
4733# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4734 case (1)
4735# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4736 idx = i + 1 + global_offset_x
4737# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4738 do f = 1, sys_size
4739# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4740 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4741# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4742 end do
4743# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4744 case (2)
4745# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4746 idx = i + 1 + global_offset_x - index_x
4747# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4748 do f = 1, sys_size - 1
4749# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4750 jump = merge(1, 0, f >= eqn_idx%mom%end)
4751# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4752 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4753# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4754 end do
4755# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4756 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4757# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4758 case (3)
4759# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4760 idx = i + 1 + global_offset_x - index_x
4761# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4762 idy = j + 1 + global_offset_y - index_y
4763# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4764 do f = 1, sys_size - 1
4765# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4766 jump = merge(1, 0, f >= eqn_idx%mom%end)
4767# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4768 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4769# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4770 end do
4771# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4772 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
4773# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4774 end select
4775# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4776 case (280) ! Isentropic vortex
4777# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4778 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
4779# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4780 ! geometry 2
4781# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4782 if (patch_id == 1) then
4783# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4784 q_prim_vf(eqn_idx%E)%sf(i, j, &
4785# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4786 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
4787# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4788 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
4789# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4790 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4791# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4792 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
4793# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4794 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
4795# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4796 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4797# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4798 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
4799# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4800 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4801# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4802 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4803# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4804 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
4805# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4806 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4807# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4808 end if
4809# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4810 case (281) ! Acoustic pulse
4811# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4812 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
4813# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4814 ! geometry 2
4815# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4816 if (patch_id == 2) then
4817# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4818 q_prim_vf(eqn_idx%E)%sf(i, j, &
4819# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4820 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
4821# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4822 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4823# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4824 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
4825# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4826 end if
4827# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4828 case (282) ! Zero-circulation vortex
4829# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4830 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
4831# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4832 ! geometry 2
4833# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4834 if (patch_id == 2) then
4835# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4836 q_prim_vf(eqn_idx%E)%sf(i, j, &
4837# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4838 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
4839# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4840 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4841# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4842 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
4843# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4844 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4845# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4846 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4847# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4848 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4849# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4850 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4851# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4852 end if
4853# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4854 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
4855# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4856 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
4857# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4858 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
4859# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4860 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
4861# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4862 ! patch_icpp(patch_id)%epsilon; defaults to 5.
4863# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4864 if (patch_id == 1) then
4865# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4866 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
4867# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4868 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
4869# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4870 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
4871# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4872 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
4873# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4874 do igq = 1, 3
4875# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4876 do jgq = 1, 3
4877# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4878 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
4879# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4880 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
4881# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4882 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
4883# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4884 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
4885# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4886 wq = gauss_w(igq)*gauss_w(jgq)
4887# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4888 rhoq = t_facq**1.4_wp
4889# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4890 pq = t_facq**2.4_wp
4891# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4892 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4893# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4894 & - r2q)
4895# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4896 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4897# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4898 & - r2q)
4899# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4900 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
4901# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4902 rho_avg = rho_avg + wq*rhoq
4903# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4904 rhou_avg = rhou_avg + wq*(rhoq*uq)
4905# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4906 rhov_avg = rhov_avg + wq*(rhoq*vq)
4907# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4908 e_avg = e_avg + wq*eq
4909# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4910 end do
4911# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4912 end do
4913# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4914 rho_avg = rho_avg*0.25_wp
4915# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4916 rhou_avg = rhou_avg*0.25_wp
4917# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4918 rhov_avg = rhov_avg*0.25_wp
4919# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4920 e_avg = e_avg*0.25_wp
4921# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4922 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
4923# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4924 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
4925# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4926 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
4927# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4928 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
4929# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4930 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
4931# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4932 end if
4933# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4934 case (291) ! Isothermal Flat Plate
4935# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4936 t_inf = 1125.0_wp
4937# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4938 t_wall = 600.0_wp
4939# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4940 p_atm = 101325.0_wp
4941# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4942
4943# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4944 ! Boundary/Shear Layer thicknesses
4945# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4946 delta_th = 0.0003_wp ! Thermal BL thickness
4947# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4948 delta_shear = 8e-3_wp ! Velocity BL thickness
4949# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4950
4951# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4952 u_max = 50.0_wp ! Freestream Velocity (m/s)
4953# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4954
4955# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4956 mw_n2 = 28.0134e-3_wp
4957# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4958 mw_o2 = 31.999e-3_wp
4959# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4960 y_n2 = 0.767_wp
4961# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4962 y_o2 = 0.233_wp
4963# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4964 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
4965# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4966 bottom_blend_u = tanh(y_cc(j)/delta_shear)
4967# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4968 bottom_blend_t = tanh(y_cc(j)/delta_th)
4969# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4970 u_mean = u_max*bottom_blend_u
4971# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4972 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
4973# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4974 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
4975# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4976 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
4977# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4978 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4979# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4980 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
4981# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4982 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
4983# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4984 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
4985# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4986 case default
4987# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4988 if (proc_rank == 0) then
4989# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4990 call s_int_to_str(patch_id, istr)
4991# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4992 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
4993# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4994 end if
4995# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4996 end select
4997 end if
4998
4999 ! Updating the patch identities bookkeeping variable
5000 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
5001
5002 q_prim_vf(eqn_idx%alf)%sf(i, j, &
5003 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5004 end if
5005 end do
5006 end do
5007 if (allocated(stored_values)) then
5008# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5009#ifdef MFC_DEBUG
5010# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5011 block
5012# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5013 use iso_fortran_env, only: output_unit
5014# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5015
5016# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5017 print *, 'm_icpp_patches.fpp:395: ', '@:DEALLOCATE(stored_values)'
5018# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5019
5020# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5021 call flush (output_unit)
5022# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5023 end block
5024# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5025#endif
5026# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5027
5028# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5029#if defined(MFC_OpenACC)
5030# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5031!$acc exit data delete(stored_values)
5032# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5033#elif defined(MFC_OpenMP)
5034# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5035!$omp target exit data map(release:stored_values)
5036# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5037#endif
5038# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5039 deallocate (stored_values)
5040# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5041#ifdef MFC_DEBUG
5042# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5043 block
5044# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5045 use iso_fortran_env, only: output_unit
5046# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5047
5048# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5049 print *, 'm_icpp_patches.fpp:395: ', '@:DEALLOCATE(x_coords)'
5050# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5051
5052# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5053 call flush (output_unit)
5054# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5055 end block
5056# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5057#endif
5058# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5059
5060# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5061#if defined(MFC_OpenACC)
5062# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5063!$acc exit data delete(x_coords)
5064# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5065#elif defined(MFC_OpenMP)
5066# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5067!$omp target exit data map(release:x_coords)
5068# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5069#endif
5070# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5071 deallocate (x_coords)
5072# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5073 end if
5074# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5075
5076# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5077 if (allocated(y_coords)) then
5078# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5079#ifdef MFC_DEBUG
5080# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5081 block
5082# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5083 use iso_fortran_env, only: output_unit
5084# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5085
5086# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5087 print *, 'm_icpp_patches.fpp:395: ', '@:DEALLOCATE(y_coords)'
5088# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5089
5090# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5091 call flush (output_unit)
5092# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5093 end block
5094# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5095#endif
5096# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5097
5098# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5099#if defined(MFC_OpenACC)
5100# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5101!$acc exit data delete(y_coords)
5102# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5103#elif defined(MFC_OpenMP)
5104# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5105!$omp target exit data map(release:y_coords)
5106# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5107#endif
5108# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5109 deallocate (y_coords)
5110# 395 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5111 end if
5112
5113 end subroutine s_icpp_varcircle
5114
5115 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
5116 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
5117
5118 ! Patch identifier
5119 integer, intent(in) :: patch_id
5120
5121#ifdef MFC_MIXED_PRECISION
5122 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5123#else
5124 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5125#endif
5126 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5127
5128 ! Generic loop iterators
5129 integer :: i, j, k
5130 real(wp) :: radius, myr, thickness
5131
5132 integer :: xRows, yRows, nRows, iix, iiy, max_files
5133# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5134 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5135# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5136 real(wp) :: x_len, x_step, y_len, y_step
5137# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5138 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5139# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5140 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
5141# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5142 real(wp) :: delta_x, delta_y
5143# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5144 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
5145# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5146 character(len=200) :: errmsg
5147# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5148 real(wp), allocatable :: stored_values(:,:,:)
5149# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5150 real(wp), allocatable :: x_coords(:), y_coords(:)
5151# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5152 logical :: files_loaded = .false.
5153# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5154 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5155# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5156 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
5157# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5158 character(len=20) :: file_num_str !< For storing the file number as a string
5159# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5160 character(len=20) :: zeros_part !< For the trailing zeros part
5161# 416 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5162 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
5163 ! Place any declaration of intermediate variables here
5164# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5165 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
5166# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5167 real(wp) :: eps
5168# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5169
5170# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5171 ! IGR Jets Arrays to stor position and radii of jets from input file
5172# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5173 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
5174# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5175 ! Variables to describe initial condition of jet
5176# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5177 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
5178# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5179 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
5180# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5181 real(wp), dimension(0:n,0:p) :: rcut_arr
5182# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5183 integer :: l, q, s !< Iterators for reading input files
5184# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5185 integer :: start, end !< Ints to keep track of position in file
5186# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5187 character(len=1000) :: line !< String to store line in file
5188# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5189 character(len=25) :: value !< String to store value in line
5190# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5191 integer :: NJet !< Number of jets
5192# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5193
5194# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5195 eps = 1e-9_wp
5196# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5197
5198# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5199 if (patch_icpp(patch_id)%hcid == 303) then
5200# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5201 eps_smooth = 3._wp
5202# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5203 open (unit=10, file="njet.txt", status="old", action="read")
5204# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5205 read (10, *) njet
5206# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5207 close (10)
5208# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5209
5210# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5211 allocate (y_th_arr(0:njet - 1))
5212# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5213 allocate (z_th_arr(0:njet - 1))
5214# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5215 allocate (r_th_arr(0:njet - 1))
5216# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5217
5218# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5219 open (unit=10, file="jets.csv", status="old", action="read")
5220# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5221 do q = 0, njet - 1
5222# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5223 read (10, '(A)') line ! Read a full line as a string
5224# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5225 start = 1
5226# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5227
5228# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5229 do l = 0, 2
5230# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5231 end = index(line(start:), ',') ! Find the next comma
5232# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5233 if (end == 0) then
5234# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5235 value = trim(adjustl(line(start:))) ! Last value in the line
5236# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5237 else
5238# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5239 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
5240# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5241 start = start + end ! Move to next value
5242# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5243 end if
5244# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5245 if (l == 0) then
5246# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5247 read (value, *) y_th_arr(q) ! Convert string to numeric value
5248# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5249 else if (l == 1) then
5250# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5251 read (value, *) z_th_arr(q)
5252# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5253 else
5254# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5255 read (value, *) r_th_arr(q)
5256# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5257 end if
5258# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5259 end do
5260# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5261 end do
5262# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5263 close (10)
5264# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5265
5266# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5267 do q = 0, p
5268# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5269 do l = 0, n
5270# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5271 rcut = 0._wp
5272# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5273 do s = 0, njet - 1
5274# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5275 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
5276# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5277 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
5278# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5279 end do
5280# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5281 rcut_arr(l, q) = rcut
5282# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5283 end do
5284# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5285 end do
5286# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5287 end if
5288
5289 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
5290 x_centroid = patch_icpp(patch_id)%x_centroid
5291 y_centroid = patch_icpp(patch_id)%y_centroid
5292 z_centroid = patch_icpp(patch_id)%z_centroid
5293 length_z = patch_icpp(patch_id)%length_z
5294 radius = patch_icpp(patch_id)%radius
5295 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5296 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5297 thickness = patch_icpp(patch_id)%epsilon
5298
5299 ! Initialize eta=1; modified if smoothing is enabled
5300 eta = 1._wp
5301
5302 ! write for all z
5303
5304 ! Assign patch vars if cell is covered and patch has write permission
5305 do k = 0, p
5306 do j = 0, n
5307 do i = 0, m
5308 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
5309
5310 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
5311 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
5312 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
5313
5314
5315 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5316 select case (patch_icpp(patch_id)%hcid)
5317# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5318 case (300) ! Rayleigh-Taylor instability
5319# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5320 rhoh = 3._wp
5321# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5322 rhol = 1._wp
5323# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5324 pref = 1.e5_wp
5325# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5326 pint = pref
5327# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5328 h = 0.7_wp
5329# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5330 lam = 0.2_wp
5331# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5332 wl = 2._wp*pi/lam
5333# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5334 amp = 0.025_wp/wl
5335# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5336
5337# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5338 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
5339# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5340
5341# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5342 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5343# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5344
5345# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5346 if (alph < eps) alph = eps
5347# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5348 if (alph > 1._wp - eps) alph = 1._wp - eps
5349# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5350
5351# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5352 if (y_cc(j) > inth) then
5353# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5354 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5355# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5356 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5357# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5358 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5359# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5360 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5361# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5362 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5363# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5364 else
5365# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5366 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5367# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5368 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5369# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5370 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5371# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5372 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5373# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5374 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5375# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5376 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
5377# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5378 end if
5379# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5380 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
5381# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5382 h = 0.0_wp
5383# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5384 lam = 1.0_wp
5385# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5386 amp = patch_icpp(patch_id)%a(2)
5387# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5388 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
5389# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5390 if (x_cc(i) > inth) then
5391# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5392 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
5393# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5394 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
5395# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5396 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
5397# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5398 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
5399# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5400 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
5401# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5402 end if
5403# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5404 case (302) ! 3D Jet with IGR
5405# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5406 ux_th = 10*sqrt(1.4*0.4)
5407# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5408 ux_am = 0.0*sqrt(1.4)
5409# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5410 p_th = 2.0_wp
5411# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5412 p_am = 1.0_wp
5413# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5414 rho_th = 1._wp
5415# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5416 rho_am = 1._wp
5417# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5418 y_th = 0.0_wp
5419# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5420 z_th = 0.0_wp
5421# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5422 r_th = 1._wp
5423# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5424 eps_smooth = 1._wp
5425# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5426 eps = 1e-6
5427# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5428
5429# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5430 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
5431# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5432 rcut = f_cut_on(r - r_th, eps_smooth)
5433# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5434 xcut = f_cut_on(x_cc(i), eps_smooth)
5435# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5436
5437# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5438 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5439# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5440 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5441# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5442 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5443# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5444
5445# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5446 if (num_fluids == 1) then
5447# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5448 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5449# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5450 else
5451# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5452 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5453# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5454 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5455# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5456 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
5457# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5458 end if
5459# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5460
5461# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5462 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5463# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5464 case (303) ! 3D Multijet
5465# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5466 eps_smooth = 3.0_wp
5467# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5468 ux_th = 10*sqrt(1.4*0.4)
5469# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5470 ux_am = 2.5*sqrt(1.4*0.4)
5471# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5472 p_th = 0.8_wp
5473# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5474 p_am = 0.4_wp
5475# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5476 rho_th = 1._wp
5477# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5478 rho_am = 1._wp
5479# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5480 eps = 1e-6
5481# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5482
5483# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5484 rcut = rcut_arr(j, k)
5485# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5486 xcut = f_cut_on(x_cc(i), eps_smooth)
5487# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5488
5489# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5490 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5491# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5492 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5493# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5494 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5495# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5496
5497# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5498 if (num_fluids == 1) then
5499# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5500 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5501# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5502 else
5503# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5504 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5505# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5506 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5507# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5508 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
5509# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5510 end if
5511# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5512
5513# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5514 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5515# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5516 case (370) ! 3D extrusion of 2D profile from external data
5517# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5518 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
5519# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5520 if (.not. files_loaded) then
5521# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5522 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5523# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5524 do f = 1, max_files
5525# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5526 write (file_num_str, '(I0)') f
5527# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5528 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
5529# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5530 end do
5531# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5532
5533# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5534 ! Common file reading setup
5535# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5536 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5537# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5538 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5539# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5540
5541# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5542 select case (num_dims)
5543# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5544 case (1, 2) ! 1D and 2D cases are similar
5545# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5546 ! Count lines
5547# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5548 line_count = 0
5549# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5550 do
5551# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5552 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5553# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5554 if (ios2 /= 0) exit
5555# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5556 line_count = line_count + 1
5557# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5558 end do
5559# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5560 close (unit2)
5561# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5562
5563# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5564 xrows = line_count
5565# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5566 yrows = 1
5567# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5568 index_x = 0
5569# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5570 if (num_dims == 2) index_x = i
5571# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5572#ifdef MFC_DEBUG
5573# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5574 block
5575# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5576 use iso_fortran_env, only: output_unit
5577# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5578
5579# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5580 print *, 'm_icpp_patches.fpp:446: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5581# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5582
5583# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5584 call flush (output_unit)
5585# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5586 end block
5587# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5588#endif
5589# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5590 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5591# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5592
5593# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5594
5595# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5596
5597# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5598#if defined(MFC_OpenACC)
5599# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5600!$acc enter data create(x_coords, stored_values)
5601# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5602#elif defined(MFC_OpenMP)
5603# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5604!$omp target enter data map(always,alloc:x_coords, stored_values)
5605# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5606#endif
5607# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5608
5609# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5610 ! Read data from all files
5611# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5612 do f = 1, max_files
5613# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5614 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5615# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5616 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5617# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5618
5619# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5620 do iter = 1, xrows
5621# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5622 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5623# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5624 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5625# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5626 end do
5627# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5628 close (unit)
5629# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5630 end do
5631# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5632
5633# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5634 ! Calculate offsets
5635# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5636 domain_xstart = x_coords(1)
5637# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5638 x_step = x_cc(1) - x_cc(0)
5639# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5640 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
5641# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5642 global_offset_x = nint(abs(delta_x)/x_step)
5643# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5644 case (3) ! 3D case - determine grid structure
5645# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5646 ! Find yRows by counting rows with same x
5647# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5648 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5649# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5650 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5651# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5652
5653# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5654 yrows = 1
5655# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5656 do
5657# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5658 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5659# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5660 if (ios2 /= 0) exit
5661# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5662 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5663# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5664 yrows = yrows + 1
5665# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5666 else
5667# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5668 exit
5669# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5670 end if
5671# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5672 end do
5673# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5674 close (unit2)
5675# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5676
5677# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5678 ! Count total rows
5679# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5680 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5681# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5682 nrows = 0
5683# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5684 do
5685# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5686 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5687# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5688 if (ios2 /= 0) exit
5689# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5690 nrows = nrows + 1
5691# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5692 end do
5693# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5694 close (unit2)
5695# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5696
5697# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5698 xrows = nrows/yrows
5699# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5700#ifdef MFC_DEBUG
5701# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5702 block
5703# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5704 use iso_fortran_env, only: output_unit
5705# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5706
5707# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5708 print *, 'm_icpp_patches.fpp:446: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5709# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5710
5711# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5712 call flush (output_unit)
5713# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5714 end block
5715# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5716#endif
5717# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5718 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5719# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5720
5721# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5722
5723# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5724
5725# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5726
5727# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5728#if defined(MFC_OpenACC)
5729# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5730!$acc enter data create(x_coords, y_coords, stored_values)
5731# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5732#elif defined(MFC_OpenMP)
5733# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5734!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5735# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5736#endif
5737# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5738 index_x = i
5739# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5740 index_y = j
5741# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5742
5743# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5744 ! Read all files
5745# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5746 do f = 1, max_files
5747# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5748 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5749# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5750 if (ios /= 0) then
5751# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5752 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5753# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5754 cycle
5755# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5756 end if
5757# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5758
5759# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5760 iter = 0
5761# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5762 do iix = 1, xrows
5763# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5764 do iiy = 1, yrows
5765# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5766 iter = iter + 1
5767# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5768 if (f == 1) then
5769# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5770 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5771# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5772 else
5773# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5774 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5775# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5776 end if
5777# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5778 if (ios /= 0) call s_mpi_abort("Error reading data")
5779# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5780 end do
5781# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5782 end do
5783# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5784 close (unit)
5785# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5786 end do
5787# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5788
5789# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5790 ! Calculate offsets
5791# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5792 x_step = x_cc(1) - x_cc(0)
5793# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5794 y_step = y_cc(1) - y_cc(0)
5795# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5796 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5797# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5798 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5799# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5800 global_offset_x = nint(abs(delta_x)/x_step)
5801# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5802 global_offset_y = nint(abs(delta_y)/y_step)
5803# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5804 end select
5805# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5806
5807# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5808 files_loaded = .true.
5809# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5810 end if
5811# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5812
5813# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5814 ! Data assignment
5815# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5816 select case (num_dims)
5817# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5818 case (1)
5819# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5820 idx = i + 1 + global_offset_x
5821# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5822 do f = 1, sys_size
5823# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5824 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5825# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5826 end do
5827# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5828 case (2)
5829# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5830 idx = i + 1 + global_offset_x - index_x
5831# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5832 do f = 1, sys_size - 1
5833# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5834 jump = merge(1, 0, f >= eqn_idx%mom%end)
5835# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5836 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5837# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5838 end do
5839# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5840 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5841# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5842 case (3)
5843# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5844 idx = i + 1 + global_offset_x - index_x
5845# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5846 idy = j + 1 + global_offset_y - index_y
5847# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5848 do f = 1, sys_size - 1
5849# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5850 jump = merge(1, 0, f >= eqn_idx%mom%end)
5851# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5852 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5853# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5854 end do
5855# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5856 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5857# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5858 end select
5859# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5860 case (380) ! Taylor-Green vortex
5861# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5862 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
5863# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5864 ! geometry 9
5865# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5866 mach = 0.1
5867# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5868 if (patch_id == 1) then
5869# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5870 q_prim_vf(eqn_idx%E)%sf(i, j, &
5871# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5872 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
5873# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5874 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
5875# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5876 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
5877# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5878 end if
5879# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5880 case default
5881# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5882 call s_int_to_str(patch_id, istr)
5883# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5884 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
5885# 446 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5886 end select
5887 end if
5888
5889 ! Updating the patch identities bookkeeping variable
5890 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5891
5892 q_prim_vf(eqn_idx%alf)%sf(i, j, &
5893 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5894 end if
5895 end do
5896 end do
5897 end do
5898 if (allocated(stored_values)) then
5899# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5900#ifdef MFC_DEBUG
5901# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5902 block
5903# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5904 use iso_fortran_env, only: output_unit
5905# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5906
5907# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5908 print *, 'm_icpp_patches.fpp:458: ', '@:DEALLOCATE(stored_values)'
5909# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5910
5911# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5912 call flush (output_unit)
5913# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5914 end block
5915# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5916#endif
5917# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5918
5919# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5920#if defined(MFC_OpenACC)
5921# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5922!$acc exit data delete(stored_values)
5923# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5924#elif defined(MFC_OpenMP)
5925# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5926!$omp target exit data map(release:stored_values)
5927# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5928#endif
5929# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5930 deallocate (stored_values)
5931# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5932#ifdef MFC_DEBUG
5933# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5934 block
5935# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5936 use iso_fortran_env, only: output_unit
5937# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5938
5939# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5940 print *, 'm_icpp_patches.fpp:458: ', '@:DEALLOCATE(x_coords)'
5941# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5942
5943# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5944 call flush (output_unit)
5945# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5946 end block
5947# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5948#endif
5949# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5950
5951# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5952#if defined(MFC_OpenACC)
5953# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5954!$acc exit data delete(x_coords)
5955# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5956#elif defined(MFC_OpenMP)
5957# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5958!$omp target exit data map(release:x_coords)
5959# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5960#endif
5961# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5962 deallocate (x_coords)
5963# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5964 end if
5965# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5966
5967# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5968 if (allocated(y_coords)) then
5969# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5970#ifdef MFC_DEBUG
5971# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5972 block
5973# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5974 use iso_fortran_env, only: output_unit
5975# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5976
5977# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5978 print *, 'm_icpp_patches.fpp:458: ', '@:DEALLOCATE(y_coords)'
5979# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5980
5981# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5982 call flush (output_unit)
5983# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5984 end block
5985# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5986#endif
5987# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5988
5989# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5990#if defined(MFC_OpenACC)
5991# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5992!$acc exit data delete(y_coords)
5993# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5994#elif defined(MFC_OpenMP)
5995# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5996!$omp target exit data map(release:y_coords)
5997# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5998#endif
5999# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6000 deallocate (y_coords)
6001# 458 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6002 end if
6003
6004 end subroutine s_icpp_3dvarcircle
6005
6006 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
6007 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
6008 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
6009
6010 integer, intent(in) :: patch_id
6011
6012#ifdef MFC_MIXED_PRECISION
6013 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6014#else
6015 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6016#endif
6017 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
6018 integer :: i, j, k !< Generic loop operators
6019 real(wp) :: a, b
6020
6021 integer :: xRows, yRows, nRows, iix, iiy, max_files
6022# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6023 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
6024# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6025 real(wp) :: x_len, x_step, y_len, y_step
6026# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6027 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
6028# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6029 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
6030# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6031 real(wp) :: delta_x, delta_y
6032# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6033 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
6034# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6035 character(len=200) :: errmsg
6036# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6037 real(wp), allocatable :: stored_values(:,:,:)
6038# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6039 real(wp), allocatable :: x_coords(:), y_coords(:)
6040# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6041 logical :: files_loaded = .false.
6042# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6043 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
6044# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6045 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
6046# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6047 character(len=20) :: file_num_str !< For storing the file number as a string
6048# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6049 character(len=20) :: zeros_part !< For the trailing zeros part
6050# 477 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6051 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
6052 ! Place any declaration of intermediate variables here
6053# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 real(wp) :: eps, eps_mhd, C_mhd
6055# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6056 real(wp) :: r, rmax, gam, umax, p0
6057# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6058 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
6059# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6060 real(wp) :: factor
6061# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6062 real(wp) :: r0, alpha, r2
6063# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6064 real(wp) :: sinA, cosA
6065# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6066 real(wp) :: r_sq
6067# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6068
6069# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6070 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
6071# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6072 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
6073# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6074 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
6075# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6076 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
6077# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6078 integer :: igq, jgq
6079# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6080
6081# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6082 ! # 291 - Shear/Thermal Layer Case
6083# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6084 real(wp) :: delta_shear, u_max, u_mean
6085# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6086 real(wp) :: T_wall, T_inf, P_atm, T_loc
6087# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6088 real(wp) :: delta_th, R_mix
6089# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6090 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
6091# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6092 real(wp) :: bottom_blend_u, bottom_blend_T
6093# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6094
6095# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6096 ! # 207
6097# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6098 real(wp) :: sigma, gauss1, gauss2
6099# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6100
6101# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6102 ! # 208
6103# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6104 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
6105# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6106
6107# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6108 eps = 1.e-9_wp
6109
6110 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
6111 x_centroid = patch_icpp(patch_id)%x_centroid
6112 y_centroid = patch_icpp(patch_id)%y_centroid
6113 a = patch_icpp(patch_id)%radii(1)
6114 b = patch_icpp(patch_id)%radii(2)
6115 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
6116 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
6117
6118 ! Initialize eta=1; modified if smoothing is enabled
6119 eta = 1._wp
6120
6121 ! Assign patch vars if cell is covered and patch has write permission
6122 do j = 0, n
6123 do i = 0, m
6124 if (patch_icpp(patch_id)%smoothen) then
6125 eta = tanh(smooth_coeff/min(dx, &
6126 & dy)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
6127 & + 0.5_wp
6128 end if
6129
6130 if ((((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp &
6131 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
6132 & 0) == smooth_patch_id) then
6133 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
6134
6135
6136 if (patch_icpp(patch_id)%hcid /= dflt_int) then
6137 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
6138# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6139 case (200) ! Two-fluid cubic interface
6140# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6141 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
6142# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6143 ! Volume Fractions
6144# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6145 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
6146# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6147 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
6148# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6149 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
6150# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6151 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
6152# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6153 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
6154# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6155 end if
6156# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6157 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
6158# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6159 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6160# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6161 rmax = 0.2_wp
6162# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6163
6164# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6165 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6166# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6167 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6168# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6169 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6170# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6171
6172# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6173 if (r < rmax) then
6174# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6175 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6176# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6177 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6178# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6179 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6180# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6181 else if (r < 2*rmax) then
6182# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6183 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6184# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6185 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6186# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6187 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
6188# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6189 else
6190# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6191 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6192# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6193 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6194# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6195 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
6196# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6197 end if
6198# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6199 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
6200# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6201 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6202# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6203 rmax = 0.2_wp
6204# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6205
6206# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6207 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6208# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6209 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6210# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6211 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6212# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6213
6214# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6215 if (r < rmax) then
6216# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6217 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6218# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6219 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6220# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6221 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6222# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6223 else if (r < 2*rmax) then
6224# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6225 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6226# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6227 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6228# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6229 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
6230# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6231 else
6232# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6233 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6234# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6235 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6236# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6237 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
6238# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6239 end if
6240# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6241
6242# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6243 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
6244# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6245 case (204) ! Rayleigh-Taylor instability
6246# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6247 rhoh = 3._wp
6248# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6249 rhol = 1._wp
6250# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6251 pref = 1.e5_wp
6252# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6253 pint = pref
6254# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6255 h = 0.7_wp
6256# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6257 lam = 0.2_wp
6258# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6259 wl = 2._wp*pi/lam
6260# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6261 amp = 0.05_wp/wl
6262# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6263
6264# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6265 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
6266# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6267
6268# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6269 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6270# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6271
6272# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6273 if (alph < eps) alph = eps
6274# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6275 if (alph > 1._wp - eps) alph = 1._wp - eps
6276# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6277
6278# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6279 if (y_cc(j) > inth) then
6280# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6281 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6282# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6283 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6284# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6285 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6286# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6287 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6288# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6289 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6290# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6291 else
6292# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6293 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6294# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6295 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6296# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6297 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6298# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6299 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6300# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6301 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6302# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6303 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
6304# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6305 end if
6306# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6307 case (205) ! 2D lung wave interaction problem
6308# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6309 h = 0.0_wp ! non dim origin y
6310# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6311 lam = 1.0_wp ! non dim lambda
6312# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6313 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
6314# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6315
6316# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6317 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
6318# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6319
6320# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6321 if (y_cc(j) > inth) then
6322# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6323 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6324# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6325 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6326# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6327 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6328# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6329 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6330# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6331 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6332# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6333 end if
6334# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6335 case (206) ! 2D lung wave interaction problem - horizontal domain
6336# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6337 h = 0.0_wp ! non dim origin y
6338# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6339 lam = 1.0_wp ! non dim lambda
6340# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6341 amp = patch_icpp(patch_id)%a(2)
6342# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6343
6344# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6345 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
6346# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6347
6348# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6349 if (x_cc(i) > intl) then ! this is the liquid
6350# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6351 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6352# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6353 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6354# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6355 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6356# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6357 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6358# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6359 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6360# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6361 end if
6362# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6363 case (207) ! Kelvin Helmholtz Instability
6364# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6365 sigma = 0.05_wp/sqrt(2.0_wp)
6366# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6367 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
6368# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6369 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
6370# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6371 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
6372# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6373 case (208) ! Richtmeyer Meshkov Instability
6374# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6375 lam = 1.0_wp
6376# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6377 eps = 1.0e-6_wp
6378# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6379 ei = 5.0_wp
6380# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6381 ! Smoothening function to smooth out sharp discontinuity in the interface
6382# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6383 if (x_cc(i) <= 0.7_wp*lam) then
6384# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6385 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
6386# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6387 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
6388# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6389 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
6390# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6391 alpha_sf6 = 1.0_wp - alpha_air
6392# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6393 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
6394# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6395 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
6396# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6397 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
6398# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6399 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
6400# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6401 end if
6402# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6403 case (250) ! MHD Orszag-Tang vortex
6404# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6405 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
6406# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6407 ! sin(4*pi*x)/sqrt(4*pi), 0)
6408# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6409
6410# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6411 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
6412# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6413 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
6414# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6415
6416# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6417 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
6418# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6419 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
6420# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6421 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
6422# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6423 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
6424# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6425 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
6426# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6427 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
6428# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6429 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
6430# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6431 ! Linear interpolation between r=0.08 and r=1.0
6432# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6433 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
6434# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6435 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
6436# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6437 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
6438# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6439 else
6440# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6441 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
6442# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6443 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
6444# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6445 end if
6446# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6447
6448# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6449 ! case 252 is for the 2D MHD Rotor problem
6450# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6451 case (252) ! 2D MHD Rotor Problem
6452# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6453 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
6454# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6455 !
6456# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6457 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
6458# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6459 ! velocity w=20, giving v_tan=2 at r=0.1
6460# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6461
6462# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6463 ! Calculate distance squared from the center
6464# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6465 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
6466# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6467
6468# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6469 ! inner radius of 0.1
6470# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6471 if (r_sq <= 0.1**2) then
6472# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6473 ! -- Inside the rotor -- Set density uniformly to 10
6474# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6475 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
6476# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6477
6478# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6479 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
6480# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6481 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
6482# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6483 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
6484# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6485
6486# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6487 ! taper width of 0.015
6488# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6489 else if (r_sq <= 0.115**2) then
6490# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6491 ! linearly smooth the function between r = 0.1 and 0.115
6492# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6493 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6494# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6495
6496# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6497 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6498# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6499 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6500# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6501 end if
6502# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6503 case (253) ! MHD Smooth Magnetic Vortex
6504# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6505 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
6506# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6507 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
6508# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6509
6510# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6511 ! velocity
6512# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6513 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6514# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6515 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6516# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6517
6518# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6519 ! magnetic field
6520# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6521 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6522# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6523 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6524# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6525
6526# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6527 ! pressure
6528# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6529 q_prim_vf(eqn_idx%E)%sf(i, j, &
6530# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6531 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
6532# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6533 case (260) ! Gaussian Divergence Pulse
6534# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6535 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
6536# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6537 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
6538# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6539 ! initialized to zero everywhere.
6540# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6541
6542# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6543 eps_mhd = patch_icpp(patch_id)%a(2)
6544# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6545 sigma = patch_icpp(patch_id)%a(3)
6546# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6547 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
6548# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6549
6550# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6551 ! B-field
6552# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6553 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6554# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6555 case (261) ! Blob
6556# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6557 r0 = 1._wp/sqrt(8._wp)
6558# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6559 r2 = x_cc(i)**2 + y_cc(j)**2
6560# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6561 r = sqrt(r2)
6562# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6563 alpha = r/r0
6564# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6565 if (alpha < 1) then
6566# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6567 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
6568# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6569 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
6570# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6571 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
6572# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6573 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
6574# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6575 end if
6576# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6577 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
6578# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6579 ! rotate by \alpha = atan(2)
6580# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6581 alpha = atan(2._wp)
6582# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6583 cosa = cos(alpha)
6584# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6585 sina = sin(alpha)
6586# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6587 ! projection along shock normal
6588# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6589 r = x_cc(i)*cosa + y_cc(j)*sina
6590# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6591
6592# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6593 if (r <= 0.5_wp) then
6594# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6595 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
6596# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6597 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6598# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6599 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
6600# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6601 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
6602# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6603 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
6604# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6605 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6606# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6607 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6608# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6609 else
6610# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6611 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
6612# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6613 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6614# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6615 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
6616# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6617 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
6618# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6619 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
6620# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6621 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6622# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6623 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6624# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6625 end if
6626# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6627 ! v^z and B^z remain zero by default
6628# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6629 case (270) ! 2D extrusion of 1D profile from external data
6630# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6631 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6632# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6633 if (.not. files_loaded) then
6634# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6635 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6636# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6637 do f = 1, max_files
6638# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6639 write (file_num_str, '(I0)') f
6640# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6641 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
6642# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6643 end do
6644# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6645
6646# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6647 ! Common file reading setup
6648# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6649 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6650# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6651 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6652# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6653
6654# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6655 select case (num_dims)
6656# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6657 case (1, 2) ! 1D and 2D cases are similar
6658# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6659 ! Count lines
6660# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6661 line_count = 0
6662# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6663 do
6664# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6665 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6666# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6667 if (ios2 /= 0) exit
6668# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6669 line_count = line_count + 1
6670# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6671 end do
6672# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6673 close (unit2)
6674# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6675
6676# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6677 xrows = line_count
6678# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6679 yrows = 1
6680# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6681 index_x = 0
6682# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6683 if (num_dims == 2) index_x = i
6684# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6685#ifdef MFC_DEBUG
6686# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6687 block
6688# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6689 use iso_fortran_env, only: output_unit
6690# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6691
6692# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6693 print *, 'm_icpp_patches.fpp:507: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6694# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6695
6696# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6697 call flush (output_unit)
6698# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6699 end block
6700# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6701#endif
6702# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6703 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6704# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6705
6706# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6707
6708# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6709
6710# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6711#if defined(MFC_OpenACC)
6712# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6713!$acc enter data create(x_coords, stored_values)
6714# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6715#elif defined(MFC_OpenMP)
6716# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6717!$omp target enter data map(always,alloc:x_coords, stored_values)
6718# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6719#endif
6720# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6721
6722# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6723 ! Read data from all files
6724# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6725 do f = 1, max_files
6726# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6727 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6728# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6729 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6730# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6731
6732# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6733 do iter = 1, xrows
6734# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6735 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6736# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6737 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6738# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6739 end do
6740# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6741 close (unit)
6742# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6743 end do
6744# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6745
6746# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6747 ! Calculate offsets
6748# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6749 domain_xstart = x_coords(1)
6750# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6751 x_step = x_cc(1) - x_cc(0)
6752# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6753 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
6754# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6755 global_offset_x = nint(abs(delta_x)/x_step)
6756# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6757 case (3) ! 3D case - determine grid structure
6758# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6759 ! Find yRows by counting rows with same x
6760# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6761 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6762# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6763 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6764# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6765
6766# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6767 yrows = 1
6768# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6769 do
6770# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6771 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6772# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6773 if (ios2 /= 0) exit
6774# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6775 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6776# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6777 yrows = yrows + 1
6778# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6779 else
6780# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6781 exit
6782# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6783 end if
6784# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6785 end do
6786# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6787 close (unit2)
6788# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6789
6790# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6791 ! Count total rows
6792# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6793 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6794# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6795 nrows = 0
6796# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6797 do
6798# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6799 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6800# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6801 if (ios2 /= 0) exit
6802# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6803 nrows = nrows + 1
6804# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6805 end do
6806# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6807 close (unit2)
6808# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6809
6810# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6811 xrows = nrows/yrows
6812# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6813#ifdef MFC_DEBUG
6814# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6815 block
6816# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6817 use iso_fortran_env, only: output_unit
6818# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6819
6820# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6821 print *, 'm_icpp_patches.fpp:507: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6822# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6823
6824# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6825 call flush (output_unit)
6826# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6827 end block
6828# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6829#endif
6830# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6831 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6832# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6833
6834# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6835
6836# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6837
6838# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6839
6840# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6841#if defined(MFC_OpenACC)
6842# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6843!$acc enter data create(x_coords, y_coords, stored_values)
6844# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6845#elif defined(MFC_OpenMP)
6846# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6847!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6848# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6849#endif
6850# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6851 index_x = i
6852# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6853 index_y = j
6854# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6855
6856# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6857 ! Read all files
6858# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6859 do f = 1, max_files
6860# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6861 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6862# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6863 if (ios /= 0) then
6864# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6865 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6866# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6867 cycle
6868# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6869 end if
6870# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6871
6872# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6873 iter = 0
6874# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6875 do iix = 1, xrows
6876# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6877 do iiy = 1, yrows
6878# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6879 iter = iter + 1
6880# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6881 if (f == 1) then
6882# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6883 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6884# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6885 else
6886# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6887 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6888# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6889 end if
6890# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6891 if (ios /= 0) call s_mpi_abort("Error reading data")
6892# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6893 end do
6894# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6895 end do
6896# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6897 close (unit)
6898# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6899 end do
6900# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6901
6902# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6903 ! Calculate offsets
6904# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6905 x_step = x_cc(1) - x_cc(0)
6906# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6907 y_step = y_cc(1) - y_cc(0)
6908# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6909 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6910# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6911 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6912# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6913 global_offset_x = nint(abs(delta_x)/x_step)
6914# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6915 global_offset_y = nint(abs(delta_y)/y_step)
6916# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6917 end select
6918# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6919
6920# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6921 files_loaded = .true.
6922# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6923 end if
6924# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6925
6926# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6927 ! Data assignment
6928# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6929 select case (num_dims)
6930# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6931 case (1)
6932# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6933 idx = i + 1 + global_offset_x
6934# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6935 do f = 1, sys_size
6936# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6937 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6938# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6939 end do
6940# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6941 case (2)
6942# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6943 idx = i + 1 + global_offset_x - index_x
6944# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6945 do f = 1, sys_size - 1
6946# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6947 jump = merge(1, 0, f >= eqn_idx%mom%end)
6948# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6949 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6950# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6951 end do
6952# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6953 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6954# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6955 case (3)
6956# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6957 idx = i + 1 + global_offset_x - index_x
6958# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6959 idy = j + 1 + global_offset_y - index_y
6960# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6961 do f = 1, sys_size - 1
6962# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6963 jump = merge(1, 0, f >= eqn_idx%mom%end)
6964# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6965 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6966# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6967 end do
6968# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6969 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6970# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6971 end select
6972# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6973 case (280) ! Isentropic vortex
6974# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6975 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6976# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6977 ! geometry 2
6978# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6979 if (patch_id == 1) then
6980# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6981 q_prim_vf(eqn_idx%E)%sf(i, j, &
6982# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6983 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
6984# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6985 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6986# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6987 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6988# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6989 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
6990# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6991 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6992# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6993 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6994# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6995 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
6996# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6997 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6998# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6999 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7000# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7001 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
7002# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7003 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
7004# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7005 end if
7006# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7007 case (281) ! Acoustic pulse
7008# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7009 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
7010# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7011 ! geometry 2
7012# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7013 if (patch_id == 2) then
7014# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7015 q_prim_vf(eqn_idx%E)%sf(i, j, &
7016# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7017 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
7018# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7019 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7020# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7021 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
7022# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7023 end if
7024# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7025 case (282) ! Zero-circulation vortex
7026# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7027 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
7028# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7029 ! geometry 2
7030# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7031 if (patch_id == 2) then
7032# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7033 q_prim_vf(eqn_idx%E)%sf(i, j, &
7034# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7035 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
7036# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7037 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7038# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7039 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
7040# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7041 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
7042# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7043 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7044# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7045 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7046# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7047 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7048# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7049 end if
7050# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7051 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
7052# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7053 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
7054# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7055 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
7056# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7057 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
7058# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7059 ! patch_icpp(patch_id)%epsilon; defaults to 5.
7060# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7061 if (patch_id == 1) then
7062# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7063 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
7064# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7065 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
7066# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7067 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
7068# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7069 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
7070# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7071 do igq = 1, 3
7072# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7073 do jgq = 1, 3
7074# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7075 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
7076# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7077 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
7078# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7079 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
7080# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7081 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
7082# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7083 wq = gauss_w(igq)*gauss_w(jgq)
7084# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7085 rhoq = t_facq**1.4_wp
7086# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7087 pq = t_facq**2.4_wp
7088# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7089 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7090# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7091 & - r2q)
7092# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7093 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7094# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7095 & - r2q)
7096# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7097 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
7098# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7099 rho_avg = rho_avg + wq*rhoq
7100# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7101 rhou_avg = rhou_avg + wq*(rhoq*uq)
7102# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7103 rhov_avg = rhov_avg + wq*(rhoq*vq)
7104# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7105 e_avg = e_avg + wq*eq
7106# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7107 end do
7108# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7109 end do
7110# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7111 rho_avg = rho_avg*0.25_wp
7112# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7113 rhou_avg = rhou_avg*0.25_wp
7114# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7115 rhov_avg = rhov_avg*0.25_wp
7116# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7117 e_avg = e_avg*0.25_wp
7118# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7119 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
7120# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7121 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
7122# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7123 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
7124# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7125 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
7126# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7127 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
7128# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7129 end if
7130# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7131 case (291) ! Isothermal Flat Plate
7132# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7133 t_inf = 1125.0_wp
7134# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7135 t_wall = 600.0_wp
7136# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7137 p_atm = 101325.0_wp
7138# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7139
7140# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7141 ! Boundary/Shear Layer thicknesses
7142# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7143 delta_th = 0.0003_wp ! Thermal BL thickness
7144# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7145 delta_shear = 8e-3_wp ! Velocity BL thickness
7146# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7147
7148# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7149 u_max = 50.0_wp ! Freestream Velocity (m/s)
7150# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7151
7152# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7153 mw_n2 = 28.0134e-3_wp
7154# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7155 mw_o2 = 31.999e-3_wp
7156# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7157 y_n2 = 0.767_wp
7158# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7159 y_o2 = 0.233_wp
7160# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7161 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
7162# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7163 bottom_blend_u = tanh(y_cc(j)/delta_shear)
7164# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7165 bottom_blend_t = tanh(y_cc(j)/delta_th)
7166# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7167 u_mean = u_max*bottom_blend_u
7168# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7169 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
7170# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7171 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
7172# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7173 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
7174# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7175 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
7176# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7177 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
7178# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7179 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
7180# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7181 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
7182# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7183 case default
7184# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7185 if (proc_rank == 0) then
7186# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7187 call s_int_to_str(patch_id, istr)
7188# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7189 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
7190# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7191 end if
7192# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7193 end select
7194 end if
7195
7196 ! Updating the patch identities bookkeeping variable
7197 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
7198 end if
7199 end do
7200 end do
7201 if (allocated(stored_values)) then
7202# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7203#ifdef MFC_DEBUG
7204# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7205 block
7206# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7207 use iso_fortran_env, only: output_unit
7208# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7209
7210# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7211 print *, 'm_icpp_patches.fpp:515: ', '@:DEALLOCATE(stored_values)'
7212# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7213
7214# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7215 call flush (output_unit)
7216# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7217 end block
7218# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7219#endif
7220# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7221
7222# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7223#if defined(MFC_OpenACC)
7224# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7225!$acc exit data delete(stored_values)
7226# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7227#elif defined(MFC_OpenMP)
7228# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7229!$omp target exit data map(release:stored_values)
7230# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7231#endif
7232# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7233 deallocate (stored_values)
7234# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7235#ifdef MFC_DEBUG
7236# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7237 block
7238# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7239 use iso_fortran_env, only: output_unit
7240# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7241
7242# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7243 print *, 'm_icpp_patches.fpp:515: ', '@:DEALLOCATE(x_coords)'
7244# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7245
7246# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7247 call flush (output_unit)
7248# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7249 end block
7250# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7251#endif
7252# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7253
7254# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7255#if defined(MFC_OpenACC)
7256# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7257!$acc exit data delete(x_coords)
7258# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7259#elif defined(MFC_OpenMP)
7260# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7261!$omp target exit data map(release:x_coords)
7262# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7263#endif
7264# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7265 deallocate (x_coords)
7266# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7267 end if
7268# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7269
7270# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7271 if (allocated(y_coords)) then
7272# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7273#ifdef MFC_DEBUG
7274# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7275 block
7276# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7277 use iso_fortran_env, only: output_unit
7278# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7279
7280# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7281 print *, 'm_icpp_patches.fpp:515: ', '@:DEALLOCATE(y_coords)'
7282# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7283
7284# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7285 call flush (output_unit)
7286# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7287 end block
7288# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7289#endif
7290# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7291
7292# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7293#if defined(MFC_OpenACC)
7294# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7295!$acc exit data delete(y_coords)
7296# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7297#elif defined(MFC_OpenMP)
7298# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7299!$omp target exit data map(release:y_coords)
7300# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7301#endif
7302# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7303 deallocate (y_coords)
7304# 515 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7305 end if
7306
7307 end subroutine s_icpp_ellipse
7308
7309 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
7310 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
7311 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
7312
7313 ! Patch identifier
7314 integer, intent(in) :: patch_id
7315
7316#ifdef MFC_MIXED_PRECISION
7317 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7318#else
7319 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7320#endif
7321 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7322
7323 ! Generic loop iterators
7324 integer :: i, j, k
7325 real(wp) :: a, b, c
7326
7327 integer :: xRows, yRows, nRows, iix, iiy, max_files
7328# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7329 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7330# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7331 real(wp) :: x_len, x_step, y_len, y_step
7332# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7333 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7334# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7335 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7336# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7337 real(wp) :: delta_x, delta_y
7338# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7339 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7340# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7341 character(len=200) :: errmsg
7342# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7343 real(wp), allocatable :: stored_values(:,:,:)
7344# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7345 real(wp), allocatable :: x_coords(:), y_coords(:)
7346# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7347 logical :: files_loaded = .false.
7348# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7349 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7350# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7351 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
7352# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7353 character(len=20) :: file_num_str !< For storing the file number as a string
7354# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7355 character(len=20) :: zeros_part !< For the trailing zeros part
7356# 537 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7357 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
7358 ! Place any declaration of intermediate variables here
7359# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7360 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
7361# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7362 real(wp) :: eps
7363# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7364
7365# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7366 ! IGR Jets Arrays to stor position and radii of jets from input file
7367# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7368 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
7369# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7370 ! Variables to describe initial condition of jet
7371# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7372 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
7373# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7374 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
7375# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7376 real(wp), dimension(0:n,0:p) :: rcut_arr
7377# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7378 integer :: l, q, s !< Iterators for reading input files
7379# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7380 integer :: start, end !< Ints to keep track of position in file
7381# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7382 character(len=1000) :: line !< String to store line in file
7383# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7384 character(len=25) :: value !< String to store value in line
7385# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7386 integer :: NJet !< Number of jets
7387# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7388
7389# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7390 eps = 1e-9_wp
7391# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7392
7393# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7394 if (patch_icpp(patch_id)%hcid == 303) then
7395# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7396 eps_smooth = 3._wp
7397# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7398 open (unit=10, file="njet.txt", status="old", action="read")
7399# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7400 read (10, *) njet
7401# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7402 close (10)
7403# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7404
7405# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7406 allocate (y_th_arr(0:njet - 1))
7407# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7408 allocate (z_th_arr(0:njet - 1))
7409# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7410 allocate (r_th_arr(0:njet - 1))
7411# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7412
7413# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7414 open (unit=10, file="jets.csv", status="old", action="read")
7415# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7416 do q = 0, njet - 1
7417# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7418 read (10, '(A)') line ! Read a full line as a string
7419# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7420 start = 1
7421# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7422
7423# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7424 do l = 0, 2
7425# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7426 end = index(line(start:), ',') ! Find the next comma
7427# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7428 if (end == 0) then
7429# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7430 value = trim(adjustl(line(start:))) ! Last value in the line
7431# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7432 else
7433# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7434 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
7435# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7436 start = start + end ! Move to next value
7437# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7438 end if
7439# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7440 if (l == 0) then
7441# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7442 read (value, *) y_th_arr(q) ! Convert string to numeric value
7443# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7444 else if (l == 1) then
7445# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7446 read (value, *) z_th_arr(q)
7447# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7448 else
7449# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7450 read (value, *) r_th_arr(q)
7451# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7452 end if
7453# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7454 end do
7455# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7456 end do
7457# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7458 close (10)
7459# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7460
7461# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7462 do q = 0, p
7463# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7464 do l = 0, n
7465# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7466 rcut = 0._wp
7467# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7468 do s = 0, njet - 1
7469# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7470 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
7471# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7472 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
7473# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7474 end do
7475# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7476 rcut_arr(l, q) = rcut
7477# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7478 end do
7479# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7480 end do
7481# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7482 end if
7483
7484 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
7485 x_centroid = patch_icpp(patch_id)%x_centroid
7486 y_centroid = patch_icpp(patch_id)%y_centroid
7487 z_centroid = patch_icpp(patch_id)%z_centroid
7488 a = patch_icpp(patch_id)%radii(1)
7489 b = patch_icpp(patch_id)%radii(2)
7490 c = patch_icpp(patch_id)%radii(3)
7491 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7492 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7493
7494 ! Initialize eta=1; modified if smoothing is enabled
7495 eta = 1._wp
7496
7497 ! Assign patch vars if cell is covered and patch has write permission
7498 do k = 0, p
7499 do j = 0, n
7500 do i = 0, m
7501 if (grid_geometry == 3) then
7502 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
7503 else
7504 cart_y = y_cc(j)
7505 cart_z = z_cc(k)
7506 end if
7507
7508 if (patch_icpp(patch_id)%smoothen) then
7509 eta = tanh(smooth_coeff/min(dx, dy, &
7510 & dz)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
7511 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
7512 end if
7513
7514 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp &
7515 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
7516 & k) == smooth_patch_id) then
7517 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
7518
7519
7520 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7521 select case (patch_icpp(patch_id)%hcid)
7522# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7523 case (300) ! Rayleigh-Taylor instability
7524# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7525 rhoh = 3._wp
7526# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7527 rhol = 1._wp
7528# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7529 pref = 1.e5_wp
7530# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7531 pint = pref
7532# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7533 h = 0.7_wp
7534# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7535 lam = 0.2_wp
7536# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7537 wl = 2._wp*pi/lam
7538# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7539 amp = 0.025_wp/wl
7540# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7541
7542# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7543 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
7544# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7545
7546# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7547 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7548# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7549
7550# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7551 if (alph < eps) alph = eps
7552# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7553 if (alph > 1._wp - eps) alph = 1._wp - eps
7554# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7555
7556# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7557 if (y_cc(j) > inth) then
7558# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7559 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7560# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7561 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7562# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7563 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7564# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7565 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7566# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7567 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7568# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7569 else
7570# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7571 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7572# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7573 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7574# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7575 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7576# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7577 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7578# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7579 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7580# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7581 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
7582# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7583 end if
7584# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7585 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
7586# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7587 h = 0.0_wp
7588# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7589 lam = 1.0_wp
7590# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7591 amp = patch_icpp(patch_id)%a(2)
7592# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7593 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
7594# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7595 if (x_cc(i) > inth) then
7596# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7597 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
7598# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7599 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
7600# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7601 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
7602# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7603 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
7604# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7605 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
7606# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7607 end if
7608# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7609 case (302) ! 3D Jet with IGR
7610# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7611 ux_th = 10*sqrt(1.4*0.4)
7612# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7613 ux_am = 0.0*sqrt(1.4)
7614# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7615 p_th = 2.0_wp
7616# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7617 p_am = 1.0_wp
7618# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7619 rho_th = 1._wp
7620# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7621 rho_am = 1._wp
7622# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7623 y_th = 0.0_wp
7624# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7625 z_th = 0.0_wp
7626# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7627 r_th = 1._wp
7628# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7629 eps_smooth = 1._wp
7630# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7631 eps = 1e-6
7632# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7633
7634# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7635 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
7636# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7637 rcut = f_cut_on(r - r_th, eps_smooth)
7638# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7639 xcut = f_cut_on(x_cc(i), eps_smooth)
7640# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7641
7642# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7643 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7644# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7645 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7646# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7647 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7648# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7649
7650# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7651 if (num_fluids == 1) then
7652# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7653 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7654# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7655 else
7656# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7657 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7658# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7659 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7660# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7661 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
7662# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7663 end if
7664# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7665
7666# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7667 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7668# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7669 case (303) ! 3D Multijet
7670# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7671 eps_smooth = 3.0_wp
7672# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7673 ux_th = 10*sqrt(1.4*0.4)
7674# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7675 ux_am = 2.5*sqrt(1.4*0.4)
7676# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7677 p_th = 0.8_wp
7678# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7679 p_am = 0.4_wp
7680# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7681 rho_th = 1._wp
7682# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7683 rho_am = 1._wp
7684# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7685 eps = 1e-6
7686# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7687
7688# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7689 rcut = rcut_arr(j, k)
7690# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7691 xcut = f_cut_on(x_cc(i), eps_smooth)
7692# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7693
7694# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7695 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7696# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7697 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7698# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7699 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7700# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7701
7702# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7703 if (num_fluids == 1) then
7704# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7705 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7706# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7707 else
7708# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7709 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7710# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7711 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7712# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7713 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
7714# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7715 end if
7716# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7717
7718# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7719 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7720# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7721 case (370) ! 3D extrusion of 2D profile from external data
7722# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7723 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7724# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7725 if (.not. files_loaded) then
7726# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7727 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7728# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7729 do f = 1, max_files
7730# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7731 write (file_num_str, '(I0)') f
7732# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7733 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
7734# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7735 end do
7736# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7737
7738# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7739 ! Common file reading setup
7740# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7741 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7742# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7743 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7744# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7745
7746# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7747 select case (num_dims)
7748# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7749 case (1, 2) ! 1D and 2D cases are similar
7750# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7751 ! Count lines
7752# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7753 line_count = 0
7754# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7755 do
7756# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7757 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7758# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7759 if (ios2 /= 0) exit
7760# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7761 line_count = line_count + 1
7762# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7763 end do
7764# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7765 close (unit2)
7766# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7767
7768# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7769 xrows = line_count
7770# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7771 yrows = 1
7772# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7773 index_x = 0
7774# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7775 if (num_dims == 2) index_x = i
7776# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7777#ifdef MFC_DEBUG
7778# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7779 block
7780# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7781 use iso_fortran_env, only: output_unit
7782# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7783
7784# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7785 print *, 'm_icpp_patches.fpp:577: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7786# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7787
7788# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7789 call flush (output_unit)
7790# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7791 end block
7792# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7793#endif
7794# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7795 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7796# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7797
7798# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7799
7800# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7801
7802# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7803#if defined(MFC_OpenACC)
7804# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7805!$acc enter data create(x_coords, stored_values)
7806# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7807#elif defined(MFC_OpenMP)
7808# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7809!$omp target enter data map(always,alloc:x_coords, stored_values)
7810# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7811#endif
7812# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7813
7814# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7815 ! Read data from all files
7816# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7817 do f = 1, max_files
7818# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7819 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7820# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7821 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7822# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7823
7824# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7825 do iter = 1, xrows
7826# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7827 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7828# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7829 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
7830# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7831 end do
7832# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7833 close (unit)
7834# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7835 end do
7836# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7837
7838# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7839 ! Calculate offsets
7840# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7841 domain_xstart = x_coords(1)
7842# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7843 x_step = x_cc(1) - x_cc(0)
7844# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7845 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
7846# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7847 global_offset_x = nint(abs(delta_x)/x_step)
7848# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7849 case (3) ! 3D case - determine grid structure
7850# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7851 ! Find yRows by counting rows with same x
7852# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7853 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7854# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7855 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7856# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7857
7858# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7859 yrows = 1
7860# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7861 do
7862# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7863 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7864# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7865 if (ios2 /= 0) exit
7866# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7867 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
7868# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7869 yrows = yrows + 1
7870# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7871 else
7872# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7873 exit
7874# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7875 end if
7876# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7877 end do
7878# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7879 close (unit2)
7880# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7881
7882# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7883 ! Count total rows
7884# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7885 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7886# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7887 nrows = 0
7888# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7889 do
7890# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7891 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7892# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7893 if (ios2 /= 0) exit
7894# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7895 nrows = nrows + 1
7896# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7897 end do
7898# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7899 close (unit2)
7900# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7901
7902# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7903 xrows = nrows/yrows
7904# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7905#ifdef MFC_DEBUG
7906# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7907 block
7908# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7909 use iso_fortran_env, only: output_unit
7910# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7911
7912# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7913 print *, 'm_icpp_patches.fpp:577: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7914# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7915
7916# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7917 call flush (output_unit)
7918# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7919 end block
7920# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7921#endif
7922# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7923 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7924# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7925
7926# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7927
7928# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7929
7930# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7931
7932# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7933#if defined(MFC_OpenACC)
7934# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7935!$acc enter data create(x_coords, y_coords, stored_values)
7936# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7937#elif defined(MFC_OpenMP)
7938# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7939!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7940# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7941#endif
7942# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7943 index_x = i
7944# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7945 index_y = j
7946# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7947
7948# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7949 ! Read all files
7950# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7951 do f = 1, max_files
7952# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7953 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7954# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7955 if (ios /= 0) then
7956# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7957 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7958# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7959 cycle
7960# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7961 end if
7962# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7963
7964# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7965 iter = 0
7966# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7967 do iix = 1, xrows
7968# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7969 do iiy = 1, yrows
7970# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7971 iter = iter + 1
7972# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7973 if (f == 1) then
7974# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7975 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7976# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7977 else
7978# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7979 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7980# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7981 end if
7982# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7983 if (ios /= 0) call s_mpi_abort("Error reading data")
7984# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7985 end do
7986# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7987 end do
7988# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7989 close (unit)
7990# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7991 end do
7992# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7993
7994# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7995 ! Calculate offsets
7996# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7997 x_step = x_cc(1) - x_cc(0)
7998# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7999 y_step = y_cc(1) - y_cc(0)
8000# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8001 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
8002# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8003 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
8004# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8005 global_offset_x = nint(abs(delta_x)/x_step)
8006# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8007 global_offset_y = nint(abs(delta_y)/y_step)
8008# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8009 end select
8010# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8011
8012# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8013 files_loaded = .true.
8014# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8015 end if
8016# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8017
8018# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8019 ! Data assignment
8020# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8021 select case (num_dims)
8022# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8023 case (1)
8024# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8025 idx = i + 1 + global_offset_x
8026# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8027 do f = 1, sys_size
8028# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8029 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8030# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8031 end do
8032# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8033 case (2)
8034# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8035 idx = i + 1 + global_offset_x - index_x
8036# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8037 do f = 1, sys_size - 1
8038# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8039 jump = merge(1, 0, f >= eqn_idx%mom%end)
8040# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8041 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8042# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8043 end do
8044# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8045 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8046# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8047 case (3)
8048# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8049 idx = i + 1 + global_offset_x - index_x
8050# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8051 idy = j + 1 + global_offset_y - index_y
8052# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8053 do f = 1, sys_size - 1
8054# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8055 jump = merge(1, 0, f >= eqn_idx%mom%end)
8056# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8057 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8058# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8059 end do
8060# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8061 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8062# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8063 end select
8064# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8065 case (380) ! Taylor-Green vortex
8066# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8067 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
8068# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8069 ! geometry 9
8070# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8071 mach = 0.1
8072# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8073 if (patch_id == 1) then
8074# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8075 q_prim_vf(eqn_idx%E)%sf(i, j, &
8076# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8077 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
8078# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8079 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
8080# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8081 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
8082# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8083 end if
8084# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8085 case default
8086# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8087 call s_int_to_str(patch_id, istr)
8088# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8089 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
8090# 577 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8091 end select
8092 end if
8093
8094 ! Updating the patch identities bookkeeping variable
8095 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
8096 end if
8097 end do
8098 end do
8099 end do
8100 if (allocated(stored_values)) then
8101# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8102#ifdef MFC_DEBUG
8103# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8104 block
8105# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8106 use iso_fortran_env, only: output_unit
8107# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8108
8109# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8110 print *, 'm_icpp_patches.fpp:586: ', '@:DEALLOCATE(stored_values)'
8111# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8112
8113# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8114 call flush (output_unit)
8115# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8116 end block
8117# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8118#endif
8119# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8120
8121# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8122#if defined(MFC_OpenACC)
8123# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8124!$acc exit data delete(stored_values)
8125# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8126#elif defined(MFC_OpenMP)
8127# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8128!$omp target exit data map(release:stored_values)
8129# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8130#endif
8131# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8132 deallocate (stored_values)
8133# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8134#ifdef MFC_DEBUG
8135# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8136 block
8137# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8138 use iso_fortran_env, only: output_unit
8139# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8140
8141# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8142 print *, 'm_icpp_patches.fpp:586: ', '@:DEALLOCATE(x_coords)'
8143# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8144
8145# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8146 call flush (output_unit)
8147# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8148 end block
8149# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8150#endif
8151# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8152
8153# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8154#if defined(MFC_OpenACC)
8155# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8156!$acc exit data delete(x_coords)
8157# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8158#elif defined(MFC_OpenMP)
8159# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8160!$omp target exit data map(release:x_coords)
8161# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8162#endif
8163# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8164 deallocate (x_coords)
8165# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8166 end if
8167# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8168
8169# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8170 if (allocated(y_coords)) then
8171# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8172#ifdef MFC_DEBUG
8173# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8174 block
8175# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8176 use iso_fortran_env, only: output_unit
8177# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8178
8179# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8180 print *, 'm_icpp_patches.fpp:586: ', '@:DEALLOCATE(y_coords)'
8181# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8182
8183# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8184 call flush (output_unit)
8185# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8186 end block
8187# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8188#endif
8189# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8190
8191# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8192#if defined(MFC_OpenACC)
8193# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8194!$acc exit data delete(y_coords)
8195# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8196#elif defined(MFC_OpenMP)
8197# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8198!$omp target exit data map(release:y_coords)
8199# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8200#endif
8201# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8202 deallocate (y_coords)
8203# 586 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8204 end if
8205
8206 end subroutine s_icpp_ellipsoid
8207
8208 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
8209 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
8210 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
8211 !! allow for the smoothing of its boundaries.
8212 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
8213
8214 integer, intent(in) :: patch_id
8215
8216#ifdef MFC_MIXED_PRECISION
8217 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8218#else
8219 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8220#endif
8221 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8222 integer :: i, j, k !< generic loop iterators
8223 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
8224
8225 integer :: xRows, yRows, nRows, iix, iiy, max_files
8226# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8227 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8228# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8229 real(wp) :: x_len, x_step, y_len, y_step
8230# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8231 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8232# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8233 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
8234# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8235 real(wp) :: delta_x, delta_y
8236# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8237 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
8238# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8239 character(len=200) :: errmsg
8240# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8241 real(wp), allocatable :: stored_values(:,:,:)
8242# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8243 real(wp), allocatable :: x_coords(:), y_coords(:)
8244# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8245 logical :: files_loaded = .false.
8246# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8247 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8248# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8249 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
8250# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8251 character(len=20) :: file_num_str !< For storing the file number as a string
8252# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8253 character(len=20) :: zeros_part !< For the trailing zeros part
8254# 607 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8255 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
8256 ! Place any declaration of intermediate variables here
8257# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8258 real(wp) :: eps, eps_mhd, C_mhd
8259# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8260 real(wp) :: r, rmax, gam, umax, p0
8261# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8262 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
8263# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8264 real(wp) :: factor
8265# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8266 real(wp) :: r0, alpha, r2
8267# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8268 real(wp) :: sinA, cosA
8269# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8270 real(wp) :: r_sq
8271# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8272
8273# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8274 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
8275# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8276 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
8277# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8278 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
8279# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8280 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
8281# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8282 integer :: igq, jgq
8283# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8284
8285# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8286 ! # 291 - Shear/Thermal Layer Case
8287# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8288 real(wp) :: delta_shear, u_max, u_mean
8289# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8290 real(wp) :: T_wall, T_inf, P_atm, T_loc
8291# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8292 real(wp) :: delta_th, R_mix
8293# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8294 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
8295# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8296 real(wp) :: bottom_blend_u, bottom_blend_T
8297# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8298
8299# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8300 ! # 207
8301# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8302 real(wp) :: sigma, gauss1, gauss2
8303# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8304
8305# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8306 ! # 208
8307# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8308 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
8309# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8310
8311# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8312 eps = 1.e-9_wp
8313
8314 pi_inf = pi_infs(1)
8315 gamma = gammas(1)
8316 lit_gamma = gs_min(1)
8317
8318 ! Transferring the rectangle's centroid and length information
8319 x_centroid = patch_icpp(patch_id)%x_centroid
8320 y_centroid = patch_icpp(patch_id)%y_centroid
8321 length_x = patch_icpp(patch_id)%length_x
8322 length_y = patch_icpp(patch_id)%length_y
8323
8324 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
8325 x_boundary%beg = x_centroid - 0.5_wp*length_x
8326 x_boundary%end = x_centroid + 0.5_wp*length_x
8327 y_boundary%beg = y_centroid - 0.5_wp*length_y
8328 y_boundary%end = y_centroid + 0.5_wp*length_y
8329
8330 ! Set eta=1 (no smoothing for this patch type)
8331 eta = 1._wp
8332
8333 ! Assign patch vars if cell is covered and patch has write permission
8334 do j = 0, n
8335 do i = 0, m
8336 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
8337 & .and. y_boundary%end >= y_cc(j)) then
8338 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
8339 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
8340
8341
8342
8343 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8344 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
8345# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8346 case (200) ! Two-fluid cubic interface
8347# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8348 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
8349# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8350 ! Volume Fractions
8351# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8352 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
8353# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8354 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
8355# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8356 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
8357# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8358 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
8359# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8360 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
8361# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8362 end if
8363# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8364 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
8365# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8366 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8367# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8368 rmax = 0.2_wp
8369# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8370
8371# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8372 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8373# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8374 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8375# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8376 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8377# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8378
8379# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8380 if (r < rmax) then
8381# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8382 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8383# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8384 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8385# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8386 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8387# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8388 else if (r < 2*rmax) then
8389# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8390 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8391# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8392 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8393# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8394 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
8395# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8396 else
8397# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8398 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8399# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8400 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8401# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8402 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
8403# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8404 end if
8405# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8406 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
8407# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8408 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8409# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8410 rmax = 0.2_wp
8411# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8412
8413# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8414 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8415# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8416 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8417# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8418 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8419# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8420
8421# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8422 if (r < rmax) then
8423# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8424 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8425# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8426 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8427# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8428 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8429# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8430 else if (r < 2*rmax) then
8431# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8432 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8433# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8434 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8435# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8436 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
8437# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8438 else
8439# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8440 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8441# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8442 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8443# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8444 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
8445# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8446 end if
8447# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8448
8449# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8450 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
8451# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8452 case (204) ! Rayleigh-Taylor instability
8453# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8454 rhoh = 3._wp
8455# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8456 rhol = 1._wp
8457# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8458 pref = 1.e5_wp
8459# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8460 pint = pref
8461# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8462 h = 0.7_wp
8463# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8464 lam = 0.2_wp
8465# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8466 wl = 2._wp*pi/lam
8467# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8468 amp = 0.05_wp/wl
8469# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8470
8471# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8472 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
8473# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8474
8475# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8476 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8477# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8478
8479# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8480 if (alph < eps) alph = eps
8481# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8482 if (alph > 1._wp - eps) alph = 1._wp - eps
8483# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8484
8485# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8486 if (y_cc(j) > inth) then
8487# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8488 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8489# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8490 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8491# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8492 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8493# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8494 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8495# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8496 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8497# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8498 else
8499# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8500 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8501# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8502 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8503# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8504 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8505# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8506 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8507# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8508 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8509# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8510 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
8511# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8512 end if
8513# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8514 case (205) ! 2D lung wave interaction problem
8515# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8516 h = 0.0_wp ! non dim origin y
8517# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8518 lam = 1.0_wp ! non dim lambda
8519# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8520 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
8521# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8522
8523# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8524 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
8525# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8526
8527# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8528 if (y_cc(j) > inth) then
8529# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8530 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8531# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8532 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8533# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8534 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8535# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8536 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8537# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8538 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8539# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8540 end if
8541# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8542 case (206) ! 2D lung wave interaction problem - horizontal domain
8543# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8544 h = 0.0_wp ! non dim origin y
8545# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8546 lam = 1.0_wp ! non dim lambda
8547# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8548 amp = patch_icpp(patch_id)%a(2)
8549# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8550
8551# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8552 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
8553# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8554
8555# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8556 if (x_cc(i) > intl) then ! this is the liquid
8557# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8558 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8559# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8560 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8561# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8562 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8563# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8564 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8565# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8566 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8567# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8568 end if
8569# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8570 case (207) ! Kelvin Helmholtz Instability
8571# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8572 sigma = 0.05_wp/sqrt(2.0_wp)
8573# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8574 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
8575# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8576 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
8577# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8578 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
8579# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8580 case (208) ! Richtmeyer Meshkov Instability
8581# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8582 lam = 1.0_wp
8583# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8584 eps = 1.0e-6_wp
8585# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8586 ei = 5.0_wp
8587# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8588 ! Smoothening function to smooth out sharp discontinuity in the interface
8589# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8590 if (x_cc(i) <= 0.7_wp*lam) then
8591# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8592 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
8593# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8594 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
8595# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8596 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
8597# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8598 alpha_sf6 = 1.0_wp - alpha_air
8599# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8600 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
8601# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8602 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
8603# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8604 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
8605# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8606 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
8607# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8608 end if
8609# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8610 case (250) ! MHD Orszag-Tang vortex
8611# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8612 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
8613# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8614 ! sin(4*pi*x)/sqrt(4*pi), 0)
8615# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8616
8617# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8618 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
8619# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8620 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
8621# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8622
8623# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8624 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
8625# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8626 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
8627# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8628 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
8629# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8630 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
8631# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8632 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
8633# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8634 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
8635# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8636 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
8637# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8638 ! Linear interpolation between r=0.08 and r=1.0
8639# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8640 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
8641# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8642 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
8643# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8644 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
8645# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8646 else
8647# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8648 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
8649# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8650 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
8651# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8652 end if
8653# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8654
8655# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8656 ! case 252 is for the 2D MHD Rotor problem
8657# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8658 case (252) ! 2D MHD Rotor Problem
8659# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8660 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
8661# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8662 !
8663# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8664 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
8665# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8666 ! velocity w=20, giving v_tan=2 at r=0.1
8667# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8668
8669# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8670 ! Calculate distance squared from the center
8671# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8672 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
8673# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8674
8675# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8676 ! inner radius of 0.1
8677# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8678 if (r_sq <= 0.1**2) then
8679# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8680 ! -- Inside the rotor -- Set density uniformly to 10
8681# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8682 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
8683# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8684
8685# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8686 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
8687# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8688 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
8689# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8690 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
8691# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8692
8693# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8694 ! taper width of 0.015
8695# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8696 else if (r_sq <= 0.115**2) then
8697# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8698 ! linearly smooth the function between r = 0.1 and 0.115
8699# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8700 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8701# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8702
8703# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8704 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8705# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8706 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8707# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8708 end if
8709# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8710 case (253) ! MHD Smooth Magnetic Vortex
8711# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8712 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
8713# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8714 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8715# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8716
8717# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8718 ! velocity
8719# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8720 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8721# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8722 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8723# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8724
8725# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8726 ! magnetic field
8727# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8728 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8729# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8730 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8731# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8732
8733# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8734 ! pressure
8735# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8736 q_prim_vf(eqn_idx%E)%sf(i, j, &
8737# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8738 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
8739# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8740 case (260) ! Gaussian Divergence Pulse
8741# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8742 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
8743# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8744 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
8745# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8746 ! initialized to zero everywhere.
8747# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8748
8749# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8750 eps_mhd = patch_icpp(patch_id)%a(2)
8751# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8752 sigma = patch_icpp(patch_id)%a(3)
8753# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8754 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8755# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8756
8757# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8758 ! B-field
8759# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8760 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8761# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8762 case (261) ! Blob
8763# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8764 r0 = 1._wp/sqrt(8._wp)
8765# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8766 r2 = x_cc(i)**2 + y_cc(j)**2
8767# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8768 r = sqrt(r2)
8769# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8770 alpha = r/r0
8771# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8772 if (alpha < 1) then
8773# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8774 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
8775# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8776 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
8777# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8778 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
8779# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8780 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
8781# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8782 end if
8783# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8784 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
8785# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8786 ! rotate by \alpha = atan(2)
8787# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8788 alpha = atan(2._wp)
8789# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8790 cosa = cos(alpha)
8791# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8792 sina = sin(alpha)
8793# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8794 ! projection along shock normal
8795# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8796 r = x_cc(i)*cosa + y_cc(j)*sina
8797# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8798
8799# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8800 if (r <= 0.5_wp) then
8801# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8802 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
8803# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8804 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8805# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8806 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
8807# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8808 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
8809# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8810 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
8811# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8812 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8813# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8814 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8815# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8816 else
8817# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8818 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
8819# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8820 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8821# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8822 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
8823# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8824 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
8825# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8826 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
8827# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8828 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8829# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8830 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8831# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8832 end if
8833# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8834 ! v^z and B^z remain zero by default
8835# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8836 case (270) ! 2D extrusion of 1D profile from external data
8837# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8838 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8839# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8840 if (.not. files_loaded) then
8841# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8842 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8843# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8844 do f = 1, max_files
8845# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8846 write (file_num_str, '(I0)') f
8847# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8848 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
8849# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8850 end do
8851# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8852
8853# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8854 ! Common file reading setup
8855# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8856 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8857# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8858 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8859# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8860
8861# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8862 select case (num_dims)
8863# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8864 case (1, 2) ! 1D and 2D cases are similar
8865# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8866 ! Count lines
8867# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8868 line_count = 0
8869# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8870 do
8871# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8872 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8873# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8874 if (ios2 /= 0) exit
8875# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8876 line_count = line_count + 1
8877# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8878 end do
8879# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8880 close (unit2)
8881# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8882
8883# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8884 xrows = line_count
8885# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8886 yrows = 1
8887# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8888 index_x = 0
8889# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8890 if (num_dims == 2) index_x = i
8891# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8892#ifdef MFC_DEBUG
8893# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8894 block
8895# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8896 use iso_fortran_env, only: output_unit
8897# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8898
8899# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8900 print *, 'm_icpp_patches.fpp:640: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8901# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8902
8903# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8904 call flush (output_unit)
8905# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8906 end block
8907# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8908#endif
8909# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8910 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8911# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8912
8913# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8914
8915# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8916
8917# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8918#if defined(MFC_OpenACC)
8919# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8920!$acc enter data create(x_coords, stored_values)
8921# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8922#elif defined(MFC_OpenMP)
8923# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8924!$omp target enter data map(always,alloc:x_coords, stored_values)
8925# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8926#endif
8927# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8928
8929# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8930 ! Read data from all files
8931# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8932 do f = 1, max_files
8933# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8934 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8935# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8936 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8937# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8938
8939# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8940 do iter = 1, xrows
8941# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8942 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8943# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8944 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8945# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8946 end do
8947# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8948 close (unit)
8949# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8950 end do
8951# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8952
8953# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8954 ! Calculate offsets
8955# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8956 domain_xstart = x_coords(1)
8957# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8958 x_step = x_cc(1) - x_cc(0)
8959# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8960 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
8961# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8962 global_offset_x = nint(abs(delta_x)/x_step)
8963# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8964 case (3) ! 3D case - determine grid structure
8965# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8966 ! Find yRows by counting rows with same x
8967# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8968 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8969# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8970 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8971# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8972
8973# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8974 yrows = 1
8975# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8976 do
8977# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8978 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8979# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8980 if (ios2 /= 0) exit
8981# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8982 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8983# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8984 yrows = yrows + 1
8985# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8986 else
8987# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8988 exit
8989# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8990 end if
8991# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8992 end do
8993# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8994 close (unit2)
8995# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8996
8997# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8998 ! Count total rows
8999# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9000 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9001# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9002 nrows = 0
9003# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9004 do
9005# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9006 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9007# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9008 if (ios2 /= 0) exit
9009# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9010 nrows = nrows + 1
9011# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9012 end do
9013# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9014 close (unit2)
9015# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9016
9017# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9018 xrows = nrows/yrows
9019# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9020#ifdef MFC_DEBUG
9021# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9022 block
9023# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9024 use iso_fortran_env, only: output_unit
9025# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9026
9027# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9028 print *, 'm_icpp_patches.fpp:640: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9029# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9030
9031# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9032 call flush (output_unit)
9033# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9034 end block
9035# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9036#endif
9037# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9038 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9039# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9040
9041# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9042
9043# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9044
9045# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9046
9047# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9048#if defined(MFC_OpenACC)
9049# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9050!$acc enter data create(x_coords, y_coords, stored_values)
9051# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9052#elif defined(MFC_OpenMP)
9053# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9054!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9055# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9056#endif
9057# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9058 index_x = i
9059# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9060 index_y = j
9061# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9062
9063# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9064 ! Read all files
9065# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9066 do f = 1, max_files
9067# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9068 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9069# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9070 if (ios /= 0) then
9071# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9072 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9073# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9074 cycle
9075# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9076 end if
9077# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9078
9079# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9080 iter = 0
9081# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9082 do iix = 1, xrows
9083# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9084 do iiy = 1, yrows
9085# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9086 iter = iter + 1
9087# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9088 if (f == 1) then
9089# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9090 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9091# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9092 else
9093# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9094 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9095# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9096 end if
9097# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9098 if (ios /= 0) call s_mpi_abort("Error reading data")
9099# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9100 end do
9101# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9102 end do
9103# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9104 close (unit)
9105# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9106 end do
9107# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9108
9109# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9110 ! Calculate offsets
9111# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9112 x_step = x_cc(1) - x_cc(0)
9113# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9114 y_step = y_cc(1) - y_cc(0)
9115# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9116 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9117# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9118 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9119# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9120 global_offset_x = nint(abs(delta_x)/x_step)
9121# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9122 global_offset_y = nint(abs(delta_y)/y_step)
9123# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9124 end select
9125# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9126
9127# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9128 files_loaded = .true.
9129# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9130 end if
9131# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9132
9133# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9134 ! Data assignment
9135# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9136 select case (num_dims)
9137# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9138 case (1)
9139# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9140 idx = i + 1 + global_offset_x
9141# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9142 do f = 1, sys_size
9143# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9144 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9145# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9146 end do
9147# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9148 case (2)
9149# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9150 idx = i + 1 + global_offset_x - index_x
9151# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9152 do f = 1, sys_size - 1
9153# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9154 jump = merge(1, 0, f >= eqn_idx%mom%end)
9155# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9156 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9157# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9158 end do
9159# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9160 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9161# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9162 case (3)
9163# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9164 idx = i + 1 + global_offset_x - index_x
9165# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9166 idy = j + 1 + global_offset_y - index_y
9167# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9168 do f = 1, sys_size - 1
9169# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9170 jump = merge(1, 0, f >= eqn_idx%mom%end)
9171# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9172 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9173# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9174 end do
9175# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9176 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9177# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9178 end select
9179# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9180 case (280) ! Isentropic vortex
9181# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9182 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
9183# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9184 ! geometry 2
9185# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9186 if (patch_id == 1) then
9187# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9188 q_prim_vf(eqn_idx%E)%sf(i, j, &
9189# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9190 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
9191# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9192 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9193# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9194 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9195# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9196 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
9197# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9198 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9199# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9200 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9201# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9202 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
9203# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9204 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9205# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9206 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9207# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9208 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
9209# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9210 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9211# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9212 end if
9213# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9214 case (281) ! Acoustic pulse
9215# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9216 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
9217# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9218 ! geometry 2
9219# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9220 if (patch_id == 2) then
9221# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9222 q_prim_vf(eqn_idx%E)%sf(i, j, &
9223# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9224 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
9225# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9226 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9227# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9228 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
9229# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9230 end if
9231# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9232 case (282) ! Zero-circulation vortex
9233# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9234 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
9235# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9236 ! geometry 2
9237# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9238 if (patch_id == 2) then
9239# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9240 q_prim_vf(eqn_idx%E)%sf(i, j, &
9241# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9242 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
9243# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9244 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9245# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9246 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
9247# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9248 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9249# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9250 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9251# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9252 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9253# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9254 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9255# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9256 end if
9257# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9258 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
9259# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9260 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
9261# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9262 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
9263# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9264 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
9265# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9266 ! patch_icpp(patch_id)%epsilon; defaults to 5.
9267# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9268 if (patch_id == 1) then
9269# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9270 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
9271# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9272 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
9273# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9274 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
9275# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9276 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
9277# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9278 do igq = 1, 3
9279# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9280 do jgq = 1, 3
9281# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9282 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
9283# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9284 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
9285# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9286 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
9287# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9288 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
9289# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9290 wq = gauss_w(igq)*gauss_w(jgq)
9291# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9292 rhoq = t_facq**1.4_wp
9293# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9294 pq = t_facq**2.4_wp
9295# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9296 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9297# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9298 & - r2q)
9299# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9300 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9301# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9302 & - r2q)
9303# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9304 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
9305# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9306 rho_avg = rho_avg + wq*rhoq
9307# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9308 rhou_avg = rhou_avg + wq*(rhoq*uq)
9309# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9310 rhov_avg = rhov_avg + wq*(rhoq*vq)
9311# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9312 e_avg = e_avg + wq*eq
9313# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9314 end do
9315# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9316 end do
9317# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9318 rho_avg = rho_avg*0.25_wp
9319# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9320 rhou_avg = rhou_avg*0.25_wp
9321# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9322 rhov_avg = rhov_avg*0.25_wp
9323# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9324 e_avg = e_avg*0.25_wp
9325# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9326 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
9327# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9328 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
9329# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9330 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
9331# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9332 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
9333# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9334 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
9335# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9336 end if
9337# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9338 case (291) ! Isothermal Flat Plate
9339# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9340 t_inf = 1125.0_wp
9341# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9342 t_wall = 600.0_wp
9343# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9344 p_atm = 101325.0_wp
9345# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9346
9347# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9348 ! Boundary/Shear Layer thicknesses
9349# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9350 delta_th = 0.0003_wp ! Thermal BL thickness
9351# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9352 delta_shear = 8e-3_wp ! Velocity BL thickness
9353# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9354
9355# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9356 u_max = 50.0_wp ! Freestream Velocity (m/s)
9357# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9358
9359# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9360 mw_n2 = 28.0134e-3_wp
9361# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9362 mw_o2 = 31.999e-3_wp
9363# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9364 y_n2 = 0.767_wp
9365# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9366 y_o2 = 0.233_wp
9367# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9368 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
9369# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9370 bottom_blend_u = tanh(y_cc(j)/delta_shear)
9371# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9372 bottom_blend_t = tanh(y_cc(j)/delta_th)
9373# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9374 u_mean = u_max*bottom_blend_u
9375# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9376 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
9377# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9378 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
9379# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9380 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
9381# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9382 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9383# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9384 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
9385# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9386 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
9387# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9388 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
9389# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9390 case default
9391# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9392 if (proc_rank == 0) then
9393# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9394 call s_int_to_str(patch_id, istr)
9395# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9396 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
9397# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9398 end if
9399# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9400 end select
9401 end if
9402
9403 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == model_eqns_4eq)) then
9404 ! zero density, reassign according to Tait EOS
9405 q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(eqn_idx%E)%sf(i, j, &
9406 & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp &
9407 & - q_prim_vf(eqn_idx%alf)%sf(i, j, 0))
9408 end if
9409
9410 ! Updating the patch identities bookkeeping variable
9411 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9412 end if
9413 end if
9414 end do
9415 end do
9416 if (allocated(stored_values)) then
9417# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9418#ifdef MFC_DEBUG
9419# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9420 block
9421# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9422 use iso_fortran_env, only: output_unit
9423# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9424
9425# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9426 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(stored_values)'
9427# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9428
9429# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9430 call flush (output_unit)
9431# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9432 end block
9433# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9434#endif
9435# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9436
9437# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9438#if defined(MFC_OpenACC)
9439# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9440!$acc exit data delete(stored_values)
9441# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9442#elif defined(MFC_OpenMP)
9443# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9444!$omp target exit data map(release:stored_values)
9445# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9446#endif
9447# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9448 deallocate (stored_values)
9449# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9450#ifdef MFC_DEBUG
9451# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9452 block
9453# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9454 use iso_fortran_env, only: output_unit
9455# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9456
9457# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9458 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(x_coords)'
9459# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9460
9461# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9462 call flush (output_unit)
9463# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9464 end block
9465# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9466#endif
9467# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9468
9469# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9470#if defined(MFC_OpenACC)
9471# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9472!$acc exit data delete(x_coords)
9473# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9474#elif defined(MFC_OpenMP)
9475# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9476!$omp target exit data map(release:x_coords)
9477# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9478#endif
9479# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9480 deallocate (x_coords)
9481# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9482 end if
9483# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9484
9485# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9486 if (allocated(y_coords)) then
9487# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9488#ifdef MFC_DEBUG
9489# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9490 block
9491# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9492 use iso_fortran_env, only: output_unit
9493# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9494
9495# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9496 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(y_coords)'
9497# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9498
9499# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9500 call flush (output_unit)
9501# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9502 end block
9503# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9504#endif
9505# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9506
9507# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9508#if defined(MFC_OpenACC)
9509# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9510!$acc exit data delete(y_coords)
9511# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9512#elif defined(MFC_OpenMP)
9513# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9514!$omp target exit data map(release:y_coords)
9515# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9516#endif
9517# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9518 deallocate (y_coords)
9519# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9520 end if
9521
9522 end subroutine s_icpp_rectangle
9523
9524 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
9525 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
9526 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
9527 !! the smoothing of its boundary.
9528 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
9529
9530 integer, intent(in) :: patch_id
9531
9532#ifdef MFC_MIXED_PRECISION
9533 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9534#else
9535 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9536#endif
9537 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9538 integer :: i, j, k !< Generic loop operators
9539 real(wp) :: a, b, c
9540
9541 integer :: xRows, yRows, nRows, iix, iiy, max_files
9542# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9543 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9544# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9545 real(wp) :: x_len, x_step, y_len, y_step
9546# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9547 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9548# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9549 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
9550# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9551 real(wp) :: delta_x, delta_y
9552# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9553 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
9554# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9555 character(len=200) :: errmsg
9556# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9557 real(wp), allocatable :: stored_values(:,:,:)
9558# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9559 real(wp), allocatable :: x_coords(:), y_coords(:)
9560# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9561 logical :: files_loaded = .false.
9562# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9563 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9564# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9565 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
9566# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9567 character(len=20) :: file_num_str !< For storing the file number as a string
9568# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9569 character(len=20) :: zeros_part !< For the trailing zeros part
9570# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9571 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
9572 ! Place any declaration of intermediate variables here
9573# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9574 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9575# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9576 real(wp) :: eps
9577# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9578
9579# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9580 ! IGR Jets Arrays to stor position and radii of jets from input file
9581# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9582 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9583# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9584 ! Variables to describe initial condition of jet
9585# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9586 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9587# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9588 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
9589# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9590 real(wp), dimension(0:n,0:p) :: rcut_arr
9591# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9592 integer :: l, q, s !< Iterators for reading input files
9593# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9594 integer :: start, end !< Ints to keep track of position in file
9595# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9596 character(len=1000) :: line !< String to store line in file
9597# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9598 character(len=25) :: value !< String to store value in line
9599# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9600 integer :: NJet !< Number of jets
9601# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9602
9603# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9604 eps = 1e-9_wp
9605# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9606
9607# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9608 if (patch_icpp(patch_id)%hcid == 303) then
9609# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9610 eps_smooth = 3._wp
9611# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 open (unit=10, file="njet.txt", status="old", action="read")
9613# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614 read (10, *) njet
9615# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616 close (10)
9617# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618
9619# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620 allocate (y_th_arr(0:njet - 1))
9621# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622 allocate (z_th_arr(0:njet - 1))
9623# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624 allocate (r_th_arr(0:njet - 1))
9625# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626
9627# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628 open (unit=10, file="jets.csv", status="old", action="read")
9629# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630 do q = 0, njet - 1
9631# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 read (10, '(A)') line ! Read a full line as a string
9633# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634 start = 1
9635# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636
9637# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638 do l = 0, 2
9639# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9640 end = index(line(start:), ',') ! Find the next comma
9641# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9642 if (end == 0) then
9643# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9644 value = trim(adjustl(line(start:))) ! Last value in the line
9645# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9646 else
9647# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9648 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
9649# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9650 start = start + end ! Move to next value
9651# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9652 end if
9653# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9654 if (l == 0) then
9655# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9656 read (value, *) y_th_arr(q) ! Convert string to numeric value
9657# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9658 else if (l == 1) then
9659# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9660 read (value, *) z_th_arr(q)
9661# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9662 else
9663# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9664 read (value, *) r_th_arr(q)
9665# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9666 end if
9667# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668 end do
9669# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 end do
9671# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 close (10)
9673# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674
9675# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676 do q = 0, p
9677# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678 do l = 0, n
9679# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 rcut = 0._wp
9681# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682 do s = 0, njet - 1
9683# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
9685# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
9687# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688 end do
9689# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690 rcut_arr(l, q) = rcut
9691# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692 end do
9693# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694 end do
9695# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696 end if
9697
9698 ! Transferring the centroid information of the line to be swept
9699 x_centroid = patch_icpp(patch_id)%x_centroid
9700 y_centroid = patch_icpp(patch_id)%y_centroid
9701 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
9702 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
9703
9704 ! Obtaining coefficients of the equation describing the sweep line
9705 a = patch_icpp(patch_id)%normal(1)
9706 b = patch_icpp(patch_id)%normal(2)
9707 c = -a*x_centroid - b*y_centroid
9708
9709 ! Initialize eta=1; modified if smoothing is enabled
9710 eta = 1._wp
9711
9712 ! Assign patch vars if cell is covered and patch has write permission
9713 do j = 0, n
9714 do i = 0, m
9715 if (patch_icpp(patch_id)%smoothen) then
9716 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy)*(a*x_cc(i) + b*y_cc(j) + c)/sqrt(a**2 + b**2))
9717 end if
9718
9719 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
9720 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
9721 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
9722
9723
9724 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9725 select case (patch_icpp(patch_id)%hcid)
9726# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9727 case (300) ! Rayleigh-Taylor instability
9728# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9729 rhoh = 3._wp
9730# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9731 rhol = 1._wp
9732# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9733 pref = 1.e5_wp
9734# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9735 pint = pref
9736# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9737 h = 0.7_wp
9738# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9739 lam = 0.2_wp
9740# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9741 wl = 2._wp*pi/lam
9742# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9743 amp = 0.025_wp/wl
9744# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9745
9746# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9747 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
9748# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9749
9750# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9751 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9752# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9753
9754# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9755 if (alph < eps) alph = eps
9756# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9757 if (alph > 1._wp - eps) alph = 1._wp - eps
9758# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9759
9760# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9761 if (y_cc(j) > inth) then
9762# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9763 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9764# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9765 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9766# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9767 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9768# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9769 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9770# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9771 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9772# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9773 else
9774# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9775 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9776# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9777 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9778# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9779 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9780# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9781 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9782# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9783 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9784# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9785 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
9786# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9787 end if
9788# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9789 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
9790# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9791 h = 0.0_wp
9792# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9793 lam = 1.0_wp
9794# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9795 amp = patch_icpp(patch_id)%a(2)
9796# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9797 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
9798# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9799 if (x_cc(i) > inth) then
9800# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9801 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
9802# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9803 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
9804# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9805 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
9806# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9807 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
9808# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9809 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
9810# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9811 end if
9812# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9813 case (302) ! 3D Jet with IGR
9814# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9815 ux_th = 10*sqrt(1.4*0.4)
9816# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9817 ux_am = 0.0*sqrt(1.4)
9818# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9819 p_th = 2.0_wp
9820# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9821 p_am = 1.0_wp
9822# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9823 rho_th = 1._wp
9824# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9825 rho_am = 1._wp
9826# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9827 y_th = 0.0_wp
9828# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9829 z_th = 0.0_wp
9830# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9831 r_th = 1._wp
9832# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9833 eps_smooth = 1._wp
9834# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9835 eps = 1e-6
9836# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9837
9838# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9839 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
9840# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9841 rcut = f_cut_on(r - r_th, eps_smooth)
9842# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9843 xcut = f_cut_on(x_cc(i), eps_smooth)
9844# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9845
9846# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9847 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9848# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9849 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9850# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9851 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9852# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9853
9854# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9855 if (num_fluids == 1) then
9856# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9857 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9858# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9859 else
9860# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9861 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9862# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9863 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9864# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9865 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
9866# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9867 end if
9868# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9869
9870# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9871 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9872# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9873 case (303) ! 3D Multijet
9874# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9875 eps_smooth = 3.0_wp
9876# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9877 ux_th = 10*sqrt(1.4*0.4)
9878# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9879 ux_am = 2.5*sqrt(1.4*0.4)
9880# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9881 p_th = 0.8_wp
9882# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9883 p_am = 0.4_wp
9884# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9885 rho_th = 1._wp
9886# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9887 rho_am = 1._wp
9888# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9889 eps = 1e-6
9890# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9891
9892# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9893 rcut = rcut_arr(j, k)
9894# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9895 xcut = f_cut_on(x_cc(i), eps_smooth)
9896# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9897
9898# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9899 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9900# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9901 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9902# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9903 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9904# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9905
9906# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9907 if (num_fluids == 1) then
9908# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9909 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9910# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9911 else
9912# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9913 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9914# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9915 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9916# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9917 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
9918# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9919 end if
9920# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9921
9922# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9923 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9924# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9925 case (370) ! 3D extrusion of 2D profile from external data
9926# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9927 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9928# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9929 if (.not. files_loaded) then
9930# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9931 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9932# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9933 do f = 1, max_files
9934# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9935 write (file_num_str, '(I0)') f
9936# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9937 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
9938# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9939 end do
9940# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9941
9942# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9943 ! Common file reading setup
9944# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9945 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9946# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9947 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9948# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9949
9950# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9951 select case (num_dims)
9952# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9953 case (1, 2) ! 1D and 2D cases are similar
9954# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9955 ! Count lines
9956# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9957 line_count = 0
9958# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9959 do
9960# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9961 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9962# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9963 if (ios2 /= 0) exit
9964# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9965 line_count = line_count + 1
9966# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9967 end do
9968# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9969 close (unit2)
9970# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9971
9972# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9973 xrows = line_count
9974# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9975 yrows = 1
9976# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9977 index_x = 0
9978# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9979 if (num_dims == 2) index_x = i
9980# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9981#ifdef MFC_DEBUG
9982# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9983 block
9984# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9985 use iso_fortran_env, only: output_unit
9986# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9987
9988# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9989 print *, 'm_icpp_patches.fpp:707: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9990# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9991
9992# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9993 call flush (output_unit)
9994# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9995 end block
9996# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9997#endif
9998# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9999 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10000# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10001
10002# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10003
10004# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10005
10006# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10007#if defined(MFC_OpenACC)
10008# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10009!$acc enter data create(x_coords, stored_values)
10010# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10011#elif defined(MFC_OpenMP)
10012# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10013!$omp target enter data map(always,alloc:x_coords, stored_values)
10014# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10015#endif
10016# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10017
10018# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10019 ! Read data from all files
10020# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10021 do f = 1, max_files
10022# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10023 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10024# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10025 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10026# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10027
10028# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10029 do iter = 1, xrows
10030# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10031 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10032# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10033 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10034# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10035 end do
10036# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10037 close (unit)
10038# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10039 end do
10040# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10041
10042# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10043 ! Calculate offsets
10044# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10045 domain_xstart = x_coords(1)
10046# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10047 x_step = x_cc(1) - x_cc(0)
10048# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10049 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
10050# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10051 global_offset_x = nint(abs(delta_x)/x_step)
10052# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10053 case (3) ! 3D case - determine grid structure
10054# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10055 ! Find yRows by counting rows with same x
10056# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10057 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10058# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10059 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10060# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10061
10062# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10063 yrows = 1
10064# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10065 do
10066# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10067 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10068# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10069 if (ios2 /= 0) exit
10070# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10071 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
10072# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10073 yrows = yrows + 1
10074# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10075 else
10076# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10077 exit
10078# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10079 end if
10080# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10081 end do
10082# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10083 close (unit2)
10084# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10085
10086# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10087 ! Count total rows
10088# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10089 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10090# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10091 nrows = 0
10092# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10093 do
10094# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10095 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10096# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10097 if (ios2 /= 0) exit
10098# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10099 nrows = nrows + 1
10100# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10101 end do
10102# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10103 close (unit2)
10104# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10105
10106# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10107 xrows = nrows/yrows
10108# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10109#ifdef MFC_DEBUG
10110# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10111 block
10112# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10113 use iso_fortran_env, only: output_unit
10114# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10115
10116# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10117 print *, 'm_icpp_patches.fpp:707: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
10118# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10119
10120# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10121 call flush (output_unit)
10122# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10123 end block
10124# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10125#endif
10126# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10127 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
10128# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10129
10130# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10131
10132# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10133
10134# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10135
10136# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10137#if defined(MFC_OpenACC)
10138# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10139!$acc enter data create(x_coords, y_coords, stored_values)
10140# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10141#elif defined(MFC_OpenMP)
10142# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10143!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
10144# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10145#endif
10146# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10147 index_x = i
10148# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10149 index_y = j
10150# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10151
10152# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10153 ! Read all files
10154# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10155 do f = 1, max_files
10156# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10157 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10158# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10159 if (ios /= 0) then
10160# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10161 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10162# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10163 cycle
10164# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10165 end if
10166# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10167
10168# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10169 iter = 0
10170# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10171 do iix = 1, xrows
10172# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10173 do iiy = 1, yrows
10174# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10175 iter = iter + 1
10176# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10177 if (f == 1) then
10178# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10179 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
10180# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10181 else
10182# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10183 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
10184# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10185 end if
10186# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10187 if (ios /= 0) call s_mpi_abort("Error reading data")
10188# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10189 end do
10190# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10191 end do
10192# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10193 close (unit)
10194# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10195 end do
10196# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10197
10198# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10199 ! Calculate offsets
10200# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10201 x_step = x_cc(1) - x_cc(0)
10202# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10203 y_step = y_cc(1) - y_cc(0)
10204# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10205 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
10206# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10207 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
10208# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10209 global_offset_x = nint(abs(delta_x)/x_step)
10210# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10211 global_offset_y = nint(abs(delta_y)/y_step)
10212# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10213 end select
10214# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10215
10216# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10217 files_loaded = .true.
10218# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10219 end if
10220# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10221
10222# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10223 ! Data assignment
10224# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10225 select case (num_dims)
10226# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10227 case (1)
10228# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10229 idx = i + 1 + global_offset_x
10230# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10231 do f = 1, sys_size
10232# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10233 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10234# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10235 end do
10236# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10237 case (2)
10238# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10239 idx = i + 1 + global_offset_x - index_x
10240# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10241 do f = 1, sys_size - 1
10242# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10243 jump = merge(1, 0, f >= eqn_idx%mom%end)
10244# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10245 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10246# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10247 end do
10248# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10249 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
10250# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10251 case (3)
10252# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10253 idx = i + 1 + global_offset_x - index_x
10254# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10255 idy = j + 1 + global_offset_y - index_y
10256# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10257 do f = 1, sys_size - 1
10258# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10259 jump = merge(1, 0, f >= eqn_idx%mom%end)
10260# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10261 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10262# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10263 end do
10264# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10265 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
10266# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10267 end select
10268# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10269 case (380) ! Taylor-Green vortex
10270# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10271 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
10272# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10273 ! geometry 9
10274# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10275 mach = 0.1
10276# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10277 if (patch_id == 1) then
10278# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10279 q_prim_vf(eqn_idx%E)%sf(i, j, &
10280# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10281 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
10282# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10283 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
10284# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10285 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
10286# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10287 end if
10288# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10289 case default
10290# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10291 call s_int_to_str(patch_id, istr)
10292# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10293 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10294# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10295 end select
10296 end if
10297
10298 ! Updating the patch identities bookkeeping variable
10299 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10300 end if
10301 end do
10302 end do
10303 if (allocated(stored_values)) then
10304# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10305#ifdef MFC_DEBUG
10306# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10307 block
10308# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10309 use iso_fortran_env, only: output_unit
10310# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10311
10312# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10313 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(stored_values)'
10314# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10315
10316# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10317 call flush (output_unit)
10318# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10319 end block
10320# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10321#endif
10322# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10323
10324# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10325#if defined(MFC_OpenACC)
10326# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10327!$acc exit data delete(stored_values)
10328# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10329#elif defined(MFC_OpenMP)
10330# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10331!$omp target exit data map(release:stored_values)
10332# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10333#endif
10334# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10335 deallocate (stored_values)
10336# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10337#ifdef MFC_DEBUG
10338# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10339 block
10340# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10341 use iso_fortran_env, only: output_unit
10342# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10343
10344# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10345 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(x_coords)'
10346# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10347
10348# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10349 call flush (output_unit)
10350# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10351 end block
10352# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10353#endif
10354# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10355
10356# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10357#if defined(MFC_OpenACC)
10358# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10359!$acc exit data delete(x_coords)
10360# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10361#elif defined(MFC_OpenMP)
10362# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10363!$omp target exit data map(release:x_coords)
10364# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10365#endif
10366# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10367 deallocate (x_coords)
10368# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10369 end if
10370# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10371
10372# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10373 if (allocated(y_coords)) then
10374# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10375#ifdef MFC_DEBUG
10376# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10377 block
10378# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10379 use iso_fortran_env, only: output_unit
10380# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10381
10382# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10383 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(y_coords)'
10384# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10385
10386# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10387 call flush (output_unit)
10388# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10389 end block
10390# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10391#endif
10392# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10393
10394# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10395#if defined(MFC_OpenACC)
10396# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10397!$acc exit data delete(y_coords)
10398# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10399#elif defined(MFC_OpenMP)
10400# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10401!$omp target exit data map(release:y_coords)
10402# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10403#endif
10404# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10405 deallocate (y_coords)
10406# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10407 end if
10408
10409 end subroutine s_icpp_sweep_line
10410
10411 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
10412 !! Geometry of the patch is well-defined when its centroid are provided.
10413 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
10414
10415 integer, intent(in) :: patch_id
10416
10417#ifdef MFC_MIXED_PRECISION
10418 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10419#else
10420 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10421#endif
10422 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10423 integer :: i, j, k !< generic loop iterators
10424 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
10425 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
10426
10427 integer :: xRows, yRows, nRows, iix, iiy, max_files
10428# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10429 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10430# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10431 real(wp) :: x_len, x_step, y_len, y_step
10432# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10433 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10434# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10435 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
10436# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10437 real(wp) :: delta_x, delta_y
10438# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10439 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
10440# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10441 character(len=200) :: errmsg
10442# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10443 real(wp), allocatable :: stored_values(:,:,:)
10444# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10445 real(wp), allocatable :: x_coords(:), y_coords(:)
10446# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10447 logical :: files_loaded = .false.
10448# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10449 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10450# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10451 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
10452# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10453 character(len=20) :: file_num_str !< For storing the file number as a string
10454# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10455 character(len=20) :: zeros_part !< For the trailing zeros part
10456# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10457 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
10458 ! Place any declaration of intermediate variables here
10459# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10460 real(wp) :: eps, eps_mhd, C_mhd
10461# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10462 real(wp) :: r, rmax, gam, umax, p0
10463# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10464 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
10465# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10466 real(wp) :: factor
10467# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10468 real(wp) :: r0, alpha, r2
10469# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10470 real(wp) :: sinA, cosA
10471# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10472 real(wp) :: r_sq
10473# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10474
10475# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10476 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
10477# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10478 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
10479# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10480 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
10481# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10482 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
10483# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10484 integer :: igq, jgq
10485# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10486
10487# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10488 ! # 291 - Shear/Thermal Layer Case
10489# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10490 real(wp) :: delta_shear, u_max, u_mean
10491# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10492 real(wp) :: T_wall, T_inf, P_atm, T_loc
10493# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10494 real(wp) :: delta_th, R_mix
10495# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10496 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
10497# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10498 real(wp) :: bottom_blend_u, bottom_blend_T
10499# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10500
10501# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10502 ! # 207
10503# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10504 real(wp) :: sigma, gauss1, gauss2
10505# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10506
10507# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10508 ! # 208
10509# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10510 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
10511# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10512
10513# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10514 eps = 1.e-9_wp
10515
10516 pi_inf = pi_infs(1)
10517 gamma = gammas(1)
10518 lit_gamma = gs_min(1)
10519
10520 ! Transferring the patch's centroid and length information
10521 x_centroid = patch_icpp(patch_id)%x_centroid
10522 y_centroid = patch_icpp(patch_id)%y_centroid
10523 length_x = patch_icpp(patch_id)%length_x
10524 length_y = patch_icpp(patch_id)%length_y
10525
10526 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
10527 x_boundary%beg = x_centroid - 0.5_wp*length_x
10528 x_boundary%end = x_centroid + 0.5_wp*length_x
10529 y_boundary%beg = y_centroid - 0.5_wp*length_y
10530 y_boundary%end = y_centroid + 0.5_wp*length_y
10531
10532 ! Set eta=1 (no smoothing for this patch type)
10533 eta = 1._wp
10534 ! U0 is the characteristic velocity of the vortex
10535 u0 = patch_icpp(patch_id)%vel(1)
10536 ! L0 is the characteristic length of the vortex
10537 l0 = patch_icpp(patch_id)%vel(2)
10538 ! Assign patch vars if cell is covered and patch has write permission
10539 do j = 0, n
10540 do i = 0, m
10541 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
10542 & .and. y_boundary%end >= y_cc(j) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
10543 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
10544
10545
10546 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10547 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
10548# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10549 case (200) ! Two-fluid cubic interface
10550# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10551 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
10552# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10553 ! Volume Fractions
10554# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10555 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
10556# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10557 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
10558# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10559 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
10560# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10561 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
10562# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10563 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
10564# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10565 end if
10566# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10567 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
10568# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10569 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10570# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10571 rmax = 0.2_wp
10572# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10573
10574# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10575 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10576# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10577 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10578# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10579 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10580# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10581
10582# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10583 if (r < rmax) then
10584# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10585 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10586# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10587 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10588# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10589 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10590# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10591 else if (r < 2*rmax) then
10592# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10593 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10594# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10595 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10596# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10597 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
10598# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10599 else
10600# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10601 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10602# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10603 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10604# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10605 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
10606# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10607 end if
10608# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10609 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
10610# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10611 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10612# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10613 rmax = 0.2_wp
10614# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10615
10616# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10617 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10618# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10619 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10620# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10621 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10622# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10623
10624# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10625 if (r < rmax) then
10626# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10627 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10628# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10629 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10630# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10631 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10632# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10633 else if (r < 2*rmax) then
10634# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10635 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10636# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10637 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10638# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10639 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
10640# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10641 else
10642# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10643 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10644# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10645 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10646# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10647 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
10648# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10649 end if
10650# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10651
10652# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10653 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
10654# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10655 case (204) ! Rayleigh-Taylor instability
10656# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10657 rhoh = 3._wp
10658# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10659 rhol = 1._wp
10660# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10661 pref = 1.e5_wp
10662# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10663 pint = pref
10664# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10665 h = 0.7_wp
10666# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10667 lam = 0.2_wp
10668# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10669 wl = 2._wp*pi/lam
10670# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10671 amp = 0.05_wp/wl
10672# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10673
10674# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10675 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
10676# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10677
10678# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10679 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10680# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10681
10682# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10683 if (alph < eps) alph = eps
10684# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10685 if (alph > 1._wp - eps) alph = 1._wp - eps
10686# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10687
10688# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10689 if (y_cc(j) > inth) then
10690# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10691 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10692# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10693 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10694# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10695 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10696# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10697 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10698# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10699 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10700# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10701 else
10702# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10703 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10704# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10705 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10706# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10707 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10708# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10709 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10710# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10711 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10712# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10713 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
10714# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10715 end if
10716# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10717 case (205) ! 2D lung wave interaction problem
10718# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10719 h = 0.0_wp ! non dim origin y
10720# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10721 lam = 1.0_wp ! non dim lambda
10722# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10723 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
10724# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10725
10726# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10727 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
10728# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10729
10730# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10731 if (y_cc(j) > inth) then
10732# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10733 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10734# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10735 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10736# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10737 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10738# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10739 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10740# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10741 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10742# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10743 end if
10744# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10745 case (206) ! 2D lung wave interaction problem - horizontal domain
10746# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10747 h = 0.0_wp ! non dim origin y
10748# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10749 lam = 1.0_wp ! non dim lambda
10750# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10751 amp = patch_icpp(patch_id)%a(2)
10752# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10753
10754# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10755 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
10756# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10757
10758# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10759 if (x_cc(i) > intl) then ! this is the liquid
10760# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10761 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10762# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10763 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10764# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10765 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10766# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10767 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10768# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10769 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10770# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10771 end if
10772# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10773 case (207) ! Kelvin Helmholtz Instability
10774# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10775 sigma = 0.05_wp/sqrt(2.0_wp)
10776# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10777 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
10778# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10779 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
10780# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10781 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
10782# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10783 case (208) ! Richtmeyer Meshkov Instability
10784# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10785 lam = 1.0_wp
10786# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10787 eps = 1.0e-6_wp
10788# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10789 ei = 5.0_wp
10790# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10791 ! Smoothening function to smooth out sharp discontinuity in the interface
10792# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10793 if (x_cc(i) <= 0.7_wp*lam) then
10794# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10795 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
10796# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10797 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
10798# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10799 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
10800# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10801 alpha_sf6 = 1.0_wp - alpha_air
10802# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10803 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
10804# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10805 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
10806# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10807 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
10808# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10809 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
10810# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10811 end if
10812# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10813 case (250) ! MHD Orszag-Tang vortex
10814# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10815 ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi),
10816# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10817 ! sin(4*pi*x)/sqrt(4*pi), 0)
10818# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10819
10820# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10821 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
10822# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10823 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
10824# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10825
10826# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10827 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
10828# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10829 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
10830# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10831 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
10832# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10833 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
10834# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10835 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
10836# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10837 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
10838# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10839 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
10840# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10841 ! Linear interpolation between r=0.08 and r=1.0
10842# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10843 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
10844# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10845 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
10846# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10847 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
10848# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10849 else
10850# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10851 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
10852# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10853 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
10854# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10855 end if
10856# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10857
10858# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10859 ! case 252 is for the 2D MHD Rotor problem
10860# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10861 case (252) ! 2D MHD Rotor Problem
10862# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10863 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
10864# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10865 !
10866# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10867 ! gamma = 1.4 Ambient medium (r > 0.1): rho = 1, p = 1, v = 0, B = (1,0,0) Rotor (r <= 0.1): rho = 10, p = 1 v has angular
10868# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10869 ! velocity w=20, giving v_tan=2 at r=0.1
10870# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10871
10872# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10873 ! Calculate distance squared from the center
10874# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10875 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10876# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10877
10878# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10879 ! inner radius of 0.1
10880# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10881 if (r_sq <= 0.1**2) then
10882# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10883 ! -- Inside the rotor -- Set density uniformly to 10
10884# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10885 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
10886# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10887
10888# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10889 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
10890# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10891 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10892# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10893 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10894# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10895
10896# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10897 ! taper width of 0.015
10898# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10899 else if (r_sq <= 0.115**2) then
10900# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10901 ! linearly smooth the function between r = 0.1 and 0.115
10902# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10903 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10904# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10905
10906# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10907 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10908# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10909 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10910# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10911 end if
10912# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10913 case (253) ! MHD Smooth Magnetic Vortex
10914# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10915 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
10916# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10917 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10918# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10919
10920# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10921 ! velocity
10922# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10923 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10924# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10925 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10926# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10927
10928# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10929 ! magnetic field
10930# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10931 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10932# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10933 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10934# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10935
10936# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10937 ! pressure
10938# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10939 q_prim_vf(eqn_idx%E)%sf(i, j, &
10940# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10941 & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3)
10942# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10943 case (260) ! Gaussian Divergence Pulse
10944# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10945 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
10946# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10947 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
10948# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10949 ! initialized to zero everywhere.
10950# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10951
10952# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10953 eps_mhd = patch_icpp(patch_id)%a(2)
10954# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10955 sigma = patch_icpp(patch_id)%a(3)
10956# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10957 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10958# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10959
10960# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10961 ! B-field
10962# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10963 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10964# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10965 case (261) ! Blob
10966# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10967 r0 = 1._wp/sqrt(8._wp)
10968# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10969 r2 = x_cc(i)**2 + y_cc(j)**2
10970# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10971 r = sqrt(r2)
10972# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10973 alpha = r/r0
10974# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10975 if (alpha < 1) then
10976# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10977 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
10978# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10979 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
10980# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10981 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
10982# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10983 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
10984# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10985 end if
10986# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10987 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
10988# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10989 ! rotate by \alpha = atan(2)
10990# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10991 alpha = atan(2._wp)
10992# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10993 cosa = cos(alpha)
10994# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10995 sina = sin(alpha)
10996# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10997 ! projection along shock normal
10998# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10999 r = x_cc(i)*cosa + y_cc(j)*sina
11000# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11001
11002# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11003 if (r <= 0.5_wp) then
11004# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11005 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
11006# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11007 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11008# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11009 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
11010# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11011 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
11012# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11013 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
11014# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11015 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
11016# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11017 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
11018# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11019 else
11020# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11021 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
11022# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11023 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11024# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11025 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
11026# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11027 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
11028# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11029 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
11030# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11031 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
11032# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11033 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
11034# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11035 end if
11036# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11037 ! v^z and B^z remain zero by default
11038# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11039 case (270) ! 2D extrusion of 1D profile from external data
11040# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11041 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
11042# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11043 if (.not. files_loaded) then
11044# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11045 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11046# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11047 do f = 1, max_files
11048# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11049 write (file_num_str, '(I0)') f
11050# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11051 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11052# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11053 end do
11054# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11055
11056# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11057 ! Common file reading setup
11058# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11059 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11060# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11061 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11062# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11063
11064# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11065 select case (num_dims)
11066# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11067 case (1, 2) ! 1D and 2D cases are similar
11068# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11069 ! Count lines
11070# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11071 line_count = 0
11072# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11073 do
11074# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11075 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11076# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11077 if (ios2 /= 0) exit
11078# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11079 line_count = line_count + 1
11080# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11081 end do
11082# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11083 close (unit2)
11084# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11085
11086# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11087 xrows = line_count
11088# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11089 yrows = 1
11090# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11091 index_x = 0
11092# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11093 if (num_dims == 2) index_x = i
11094# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11095#ifdef MFC_DEBUG
11096# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11097 block
11098# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11099 use iso_fortran_env, only: output_unit
11100# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11101
11102# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11103 print *, 'm_icpp_patches.fpp:769: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11104# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11105
11106# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11107 call flush (output_unit)
11108# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11109 end block
11110# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11111#endif
11112# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11113 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11114# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11115
11116# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11117
11118# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11119
11120# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11121#if defined(MFC_OpenACC)
11122# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11123!$acc enter data create(x_coords, stored_values)
11124# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11125#elif defined(MFC_OpenMP)
11126# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11127!$omp target enter data map(always,alloc:x_coords, stored_values)
11128# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11129#endif
11130# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11131
11132# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11133 ! Read data from all files
11134# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11135 do f = 1, max_files
11136# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11137 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11138# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11139 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11140# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11141
11142# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11143 do iter = 1, xrows
11144# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11145 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11146# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11147 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11148# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11149 end do
11150# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11151 close (unit)
11152# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11153 end do
11154# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11155
11156# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11157 ! Calculate offsets
11158# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11159 domain_xstart = x_coords(1)
11160# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11161 x_step = x_cc(1) - x_cc(0)
11162# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11163 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
11164# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11165 global_offset_x = nint(abs(delta_x)/x_step)
11166# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11167 case (3) ! 3D case - determine grid structure
11168# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11169 ! Find yRows by counting rows with same x
11170# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11171 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11172# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11173 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11174# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11175
11176# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11177 yrows = 1
11178# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11179 do
11180# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11181 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11182# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11183 if (ios2 /= 0) exit
11184# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11185 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11186# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11187 yrows = yrows + 1
11188# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11189 else
11190# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11191 exit
11192# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11193 end if
11194# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11195 end do
11196# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11197 close (unit2)
11198# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11199
11200# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11201 ! Count total rows
11202# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11203 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11204# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11205 nrows = 0
11206# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11207 do
11208# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11209 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11210# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11211 if (ios2 /= 0) exit
11212# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11213 nrows = nrows + 1
11214# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11215 end do
11216# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11217 close (unit2)
11218# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11219
11220# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11221 xrows = nrows/yrows
11222# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11223#ifdef MFC_DEBUG
11224# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11225 block
11226# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11227 use iso_fortran_env, only: output_unit
11228# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11229
11230# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11231 print *, 'm_icpp_patches.fpp:769: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11232# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11233
11234# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11235 call flush (output_unit)
11236# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11237 end block
11238# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11239#endif
11240# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11241 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11242# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11243
11244# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11245
11246# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11247
11248# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11249
11250# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11251#if defined(MFC_OpenACC)
11252# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11253!$acc enter data create(x_coords, y_coords, stored_values)
11254# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11255#elif defined(MFC_OpenMP)
11256# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11257!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11258# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11259#endif
11260# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11261 index_x = i
11262# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11263 index_y = j
11264# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11265
11266# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11267 ! Read all files
11268# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11269 do f = 1, max_files
11270# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11271 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11272# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11273 if (ios /= 0) then
11274# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11275 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11276# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11277 cycle
11278# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11279 end if
11280# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11281
11282# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11283 iter = 0
11284# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11285 do iix = 1, xrows
11286# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11287 do iiy = 1, yrows
11288# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11289 iter = iter + 1
11290# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11291 if (f == 1) then
11292# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11293 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11294# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11295 else
11296# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11297 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11298# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11299 end if
11300# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11301 if (ios /= 0) call s_mpi_abort("Error reading data")
11302# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11303 end do
11304# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11305 end do
11306# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11307 close (unit)
11308# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11309 end do
11310# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11311
11312# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11313 ! Calculate offsets
11314# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11315 x_step = x_cc(1) - x_cc(0)
11316# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11317 y_step = y_cc(1) - y_cc(0)
11318# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11319 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11320# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11321 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11322# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11323 global_offset_x = nint(abs(delta_x)/x_step)
11324# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11325 global_offset_y = nint(abs(delta_y)/y_step)
11326# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11327 end select
11328# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11329
11330# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11331 files_loaded = .true.
11332# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11333 end if
11334# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11335
11336# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11337 ! Data assignment
11338# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11339 select case (num_dims)
11340# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11341 case (1)
11342# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11343 idx = i + 1 + global_offset_x
11344# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11345 do f = 1, sys_size
11346# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11347 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11348# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11349 end do
11350# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11351 case (2)
11352# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11353 idx = i + 1 + global_offset_x - index_x
11354# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11355 do f = 1, sys_size - 1
11356# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11357 jump = merge(1, 0, f >= eqn_idx%mom%end)
11358# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11359 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11360# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11361 end do
11362# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11363 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11364# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11365 case (3)
11366# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11367 idx = i + 1 + global_offset_x - index_x
11368# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11369 idy = j + 1 + global_offset_y - index_y
11370# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11371 do f = 1, sys_size - 1
11372# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11373 jump = merge(1, 0, f >= eqn_idx%mom%end)
11374# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11375 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11376# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11377 end do
11378# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11379 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
11380# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11381 end select
11382# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11383 case (280) ! Isentropic vortex
11384# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11385 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
11386# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11387 ! geometry 2
11388# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11389 if (patch_id == 1) then
11390# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11391 q_prim_vf(eqn_idx%E)%sf(i, j, &
11392# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11393 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
11394# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11395 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
11396# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11397 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11398# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11399 & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) &
11400# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11401 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
11402# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11403 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11404# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11405 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
11406# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11407 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11408# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11409 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11410# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11411 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
11412# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11413 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11414# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11415 end if
11416# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11417 case (281) ! Acoustic pulse
11418# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11419 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
11420# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11421 ! geometry 2
11422# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11423 if (patch_id == 2) then
11424# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11425 q_prim_vf(eqn_idx%E)%sf(i, j, &
11426# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11427 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
11428# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11429 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11430# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11431 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
11432# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11433 end if
11434# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11435 case (282) ! Zero-circulation vortex
11436# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11437 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
11438# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11439 ! geometry 2
11440# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11441 if (patch_id == 2) then
11442# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11443 q_prim_vf(eqn_idx%E)%sf(i, j, &
11444# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11445 & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1))
11446# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11447 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11448# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11449 & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1))
11450# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11451 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11452# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11453 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11454# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11455 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11456# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11457 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11458# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11459 end if
11460# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11461 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
11462# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11463 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
11464# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11465 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
11466# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11467 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
11468# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11469 ! patch_icpp(patch_id)%epsilon; defaults to 5.
11470# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11471 if (patch_id == 1) then
11472# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11473 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
11474# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11475 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
11476# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11477 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
11478# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11479 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
11480# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11481 do igq = 1, 3
11482# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11483 do jgq = 1, 3
11484# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11485 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
11486# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11487 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
11488# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11489 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
11490# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11491 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
11492# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11493 wq = gauss_w(igq)*gauss_w(jgq)
11494# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11495 rhoq = t_facq**1.4_wp
11496# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11497 pq = t_facq**2.4_wp
11498# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11499 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11500# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11501 & - r2q)
11502# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11503 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11504# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11505 & - r2q)
11506# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11507 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
11508# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11509 rho_avg = rho_avg + wq*rhoq
11510# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11511 rhou_avg = rhou_avg + wq*(rhoq*uq)
11512# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11513 rhov_avg = rhov_avg + wq*(rhoq*vq)
11514# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11515 e_avg = e_avg + wq*eq
11516# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11517 end do
11518# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11519 end do
11520# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11521 rho_avg = rho_avg*0.25_wp
11522# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11523 rhou_avg = rhou_avg*0.25_wp
11524# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11525 rhov_avg = rhov_avg*0.25_wp
11526# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11527 e_avg = e_avg*0.25_wp
11528# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11529 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
11530# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11531 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
11532# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11533 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
11534# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11535 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
11536# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11537 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
11538# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11539 end if
11540# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11541 case (291) ! Isothermal Flat Plate
11542# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11543 t_inf = 1125.0_wp
11544# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11545 t_wall = 600.0_wp
11546# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11547 p_atm = 101325.0_wp
11548# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11549
11550# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11551 ! Boundary/Shear Layer thicknesses
11552# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11553 delta_th = 0.0003_wp ! Thermal BL thickness
11554# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11555 delta_shear = 8e-3_wp ! Velocity BL thickness
11556# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11557
11558# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11559 u_max = 50.0_wp ! Freestream Velocity (m/s)
11560# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11561
11562# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11563 mw_n2 = 28.0134e-3_wp
11564# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11565 mw_o2 = 31.999e-3_wp
11566# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11567 y_n2 = 0.767_wp
11568# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11569 y_o2 = 0.233_wp
11570# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11571 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
11572# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11573 bottom_blend_u = tanh(y_cc(j)/delta_shear)
11574# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11575 bottom_blend_t = tanh(y_cc(j)/delta_th)
11576# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11577 u_mean = u_max*bottom_blend_u
11578# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11579 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
11580# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11581 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
11582# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11583 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
11584# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11585 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11586# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11587 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
11588# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11589 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
11590# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11591 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
11592# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11593 case default
11594# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11595 if (proc_rank == 0) then
11596# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11597 call s_int_to_str(patch_id, istr)
11598# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11599 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
11600# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11601 end if
11602# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11603 end select
11604 end if
11605
11606 ! Updating the patch identities bookkeeping variable
11607 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
11608
11609 ! Assign Parameters
11610 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
11611 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
11612 q_prim_vf(eqn_idx%E)%sf(i, j, &
11613 & 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/l0 + cos(2*y_cc(j))/l0)*(q_prim_vf(1)%sf(i, j, &
11614 & 0)*u0*u0)/16
11615 end if
11616 end do
11617 end do
11618 if (allocated(stored_values)) then
11619# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11620#ifdef MFC_DEBUG
11621# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11622 block
11623# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11624 use iso_fortran_env, only: output_unit
11625# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11626
11627# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11628 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(stored_values)'
11629# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11630
11631# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11632 call flush (output_unit)
11633# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11634 end block
11635# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11636#endif
11637# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11638
11639# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11640#if defined(MFC_OpenACC)
11641# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11642!$acc exit data delete(stored_values)
11643# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11644#elif defined(MFC_OpenMP)
11645# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11646!$omp target exit data map(release:stored_values)
11647# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11648#endif
11649# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11650 deallocate (stored_values)
11651# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11652#ifdef MFC_DEBUG
11653# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11654 block
11655# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11656 use iso_fortran_env, only: output_unit
11657# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11658
11659# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11660 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(x_coords)'
11661# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11662
11663# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11664 call flush (output_unit)
11665# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11666 end block
11667# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11668#endif
11669# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11670
11671# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11672#if defined(MFC_OpenACC)
11673# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11674!$acc exit data delete(x_coords)
11675# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11676#elif defined(MFC_OpenMP)
11677# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678!$omp target exit data map(release:x_coords)
11679# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680#endif
11681# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682 deallocate (x_coords)
11683# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 end if
11685# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686
11687# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688 if (allocated(y_coords)) then
11689# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690#ifdef MFC_DEBUG
11691# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692 block
11693# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694 use iso_fortran_env, only: output_unit
11695# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696
11697# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(y_coords)'
11699# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700
11701# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702 call flush (output_unit)
11703# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704 end block
11705# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706#endif
11707# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708
11709# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710#if defined(MFC_OpenACC)
11711# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712!$acc exit data delete(y_coords)
11713# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714#elif defined(MFC_OpenMP)
11715# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716!$omp target exit data map(release:y_coords)
11717# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718#endif
11719# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720 deallocate (y_coords)
11721# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 end if
11723
11724 end subroutine s_icpp_2d_taylorgreen_vortex
11725
11726 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
11727 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
11728
11729 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
11730
11731 ! Patch identifier
11732 integer, intent(in) :: patch_id
11733
11734#ifdef MFC_MIXED_PRECISION
11735 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11736#else
11737 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11738#endif
11739 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11740
11741 ! Generic loop iterators
11742 integer :: i, j, k
11743 ! Placeholders for the cell boundary values
11744 real(wp) :: pi_inf, gamma, lit_gamma
11745
11746 integer :: xRows, yRows, nRows, iix, iiy, max_files
11747# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11748 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11749# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750 real(wp) :: x_len, x_step, y_len, y_step
11751# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11753# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
11755# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756 real(wp) :: delta_x, delta_y
11757# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
11759# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760 character(len=200) :: errmsg
11761# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762 real(wp), allocatable :: stored_values(:,:,:)
11763# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764 real(wp), allocatable :: x_coords(:), y_coords(:)
11765# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766 logical :: files_loaded = .false.
11767# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11769# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
11771# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 character(len=20) :: file_num_str !< For storing the file number as a string
11773# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 character(len=20) :: zeros_part !< For the trailing zeros part
11775# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
11777 ! Place any declaration of intermediate variables here
11778# 809 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11779 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
11780
11781 pi_inf = pi_infs(1)
11782 gamma = gammas(1)
11783 lit_gamma = gs_min(1)
11784
11785 ! Transferring the patch's centroid and length information
11786 x_centroid = patch_icpp(patch_id)%x_centroid
11787 length_x = patch_icpp(patch_id)%length_x
11788
11789 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
11790 x_boundary%beg = x_centroid - 0.5_wp*length_x
11791 x_boundary%end = x_centroid + 0.5_wp*length_x
11792
11793 ! Set eta=1 (no smoothing for this patch type)
11794 eta = 1._wp
11795
11796 ! Assign patch vars if cell is covered and patch has write permission
11797 do i = 0, m
11798 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, &
11799 & 0, 0))) then
11800 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
11801
11802
11803 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11804 select case (patch_icpp(patch_id)%hcid)
11805# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11806 case (150) ! 1D Smooth Alfven Case for MHD
11807# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 ! velocity
11809# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11811# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11813# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814
11815# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816 ! magnetic field
11817# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11819# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11821# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
11823# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
11825# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 ! SDtoolbox)
11827# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 if (.not. files_loaded) then
11829# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11831# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 do f = 1, max_files
11833# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834 write (file_num_str, '(I0)') f
11835# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11837# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 end do
11839# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840
11841# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842 ! Common file reading setup
11843# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11845# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11847# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848
11849# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850 select case (num_dims)
11851# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852 case (1, 2) ! 1D and 2D cases are similar
11853# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854 ! Count lines
11855# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856 line_count = 0
11857# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 do
11859# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11861# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 if (ios2 /= 0) exit
11863# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864 line_count = line_count + 1
11865# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 end do
11867# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868 close (unit2)
11869# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870
11871# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872 xrows = line_count
11873# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874 yrows = 1
11875# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876 index_x = 0
11877# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878 if (num_dims == 2) index_x = i
11879# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880#ifdef MFC_DEBUG
11881# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882 block
11883# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884 use iso_fortran_env, only: output_unit
11885# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886
11887# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888 print *, 'm_icpp_patches.fpp:834: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11889# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890
11891# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892 call flush (output_unit)
11893# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 end block
11895# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896#endif
11897# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11899# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900
11901# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902
11903# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904
11905# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906#if defined(MFC_OpenACC)
11907# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908!$acc enter data create(x_coords, stored_values)
11909# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910#elif defined(MFC_OpenMP)
11911# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912!$omp target enter data map(always,alloc:x_coords, stored_values)
11913# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914#endif
11915# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916
11917# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918 ! Read data from all files
11919# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 do f = 1, max_files
11921# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11923# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11925# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926
11927# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928 do iter = 1, xrows
11929# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11931# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11933# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934 end do
11935# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 close (unit)
11937# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 end do
11939# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940
11941# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942 ! Calculate offsets
11943# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 domain_xstart = x_coords(1)
11945# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 x_step = x_cc(1) - x_cc(0)
11947# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
11949# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950 global_offset_x = nint(abs(delta_x)/x_step)
11951# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952 case (3) ! 3D case - determine grid structure
11953# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954 ! Find yRows by counting rows with same x
11955# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11957# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11959# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960
11961# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962 yrows = 1
11963# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964 do
11965# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11967# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968 if (ios2 /= 0) exit
11969# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11971# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972 yrows = yrows + 1
11973# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 else
11975# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 exit
11977# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978 end if
11979# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980 end do
11981# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982 close (unit2)
11983# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11984
11985# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11986 ! Count total rows
11987# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11988 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11989# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11990 nrows = 0
11991# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11992 do
11993# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11994 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11995# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11996 if (ios2 /= 0) exit
11997# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11998 nrows = nrows + 1
11999# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12000 end do
12001# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12002 close (unit2)
12003# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12004
12005# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12006 xrows = nrows/yrows
12007# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12008#ifdef MFC_DEBUG
12009# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12010 block
12011# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12012 use iso_fortran_env, only: output_unit
12013# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12014
12015# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12016 print *, 'm_icpp_patches.fpp:834: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12017# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12018
12019# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12020 call flush (output_unit)
12021# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12022 end block
12023# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12024#endif
12025# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12026 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12027# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12028
12029# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12030
12031# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12032
12033# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12034
12035# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12036#if defined(MFC_OpenACC)
12037# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12038!$acc enter data create(x_coords, y_coords, stored_values)
12039# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12040#elif defined(MFC_OpenMP)
12041# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12042!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12043# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12044#endif
12045# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12046 index_x = i
12047# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12048 index_y = j
12049# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12050
12051# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12052 ! Read all files
12053# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12054 do f = 1, max_files
12055# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12056 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12057# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12058 if (ios /= 0) then
12059# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12060 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12061# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12062 cycle
12063# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12064 end if
12065# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12066
12067# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12068 iter = 0
12069# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12070 do iix = 1, xrows
12071# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12072 do iiy = 1, yrows
12073# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12074 iter = iter + 1
12075# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12076 if (f == 1) then
12077# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12078 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12079# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12080 else
12081# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12082 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12083# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12084 end if
12085# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12086 if (ios /= 0) call s_mpi_abort("Error reading data")
12087# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12088 end do
12089# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12090 end do
12091# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12092 close (unit)
12093# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12094 end do
12095# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12096
12097# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12098 ! Calculate offsets
12099# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12100 x_step = x_cc(1) - x_cc(0)
12101# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12102 y_step = y_cc(1) - y_cc(0)
12103# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12104 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12105# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12106 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12107# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12108 global_offset_x = nint(abs(delta_x)/x_step)
12109# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12110 global_offset_y = nint(abs(delta_y)/y_step)
12111# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12112 end select
12113# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12114
12115# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12116 files_loaded = .true.
12117# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12118 end if
12119# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12120
12121# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12122 ! Data assignment
12123# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12124 select case (num_dims)
12125# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12126 case (1)
12127# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12128 idx = i + 1 + global_offset_x
12129# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12130 do f = 1, sys_size
12131# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12132 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12133# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12134 end do
12135# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12136 case (2)
12137# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12138 idx = i + 1 + global_offset_x - index_x
12139# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12140 do f = 1, sys_size - 1
12141# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12142 jump = merge(1, 0, f >= eqn_idx%mom%end)
12143# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12144 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12145# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12146 end do
12147# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12148 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
12149# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12150 case (3)
12151# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12152 idx = i + 1 + global_offset_x - index_x
12153# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12154 idy = j + 1 + global_offset_y - index_y
12155# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12156 do f = 1, sys_size - 1
12157# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12158 jump = merge(1, 0, f >= eqn_idx%mom%end)
12159# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12160 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12161# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12162 end do
12163# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12164 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
12165# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12166 end select
12167# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12168 case (180) ! Shu-Osher problem
12169# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12170 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
12171# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12172 ! 0.2*sin(5*x)"
12173# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12174 if (patch_id == 2) then
12175# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12176 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
12177# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12178 end if
12179# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12180 case (181) ! Titarev-Torro problem
12181# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12182 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
12183# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12184 ! "1 + 0.1*sin(20*x*pi)"
12185# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12186 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
12187# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12188 case (182) ! Multi-component diffusion
12189# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12190 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
12191# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12192 x_mid_diffu = 0.05_wp/2.0_wp
12193# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12194 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
12195# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12196 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
12197# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12198 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12199# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12200 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
12201# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12202 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
12203# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12204
12205# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12206 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
12207# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12208 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
12209# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12210 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
12211# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12212 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
12213# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12214
12215# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12216 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
12217# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12218 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
12219# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12220 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
12221# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12222 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
12223# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12224
12225# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12226 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
12227# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12228
12229# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12230 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
12231# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12232
12233# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12234 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
12235# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12236
12237# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12238 case(191) ! 1D Dual Isothermal case
12239# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12240
12241# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12242 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
12243# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12244 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12245# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12246 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
12247# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12248
12249# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12250 if (x_cc(i) <= 0.025_wp) then
12251# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12252 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
12253# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12254 else
12255# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12256 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
12257# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12258 end if
12259# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12260
12261# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 molar_mass_inv = 1.0_wp/2.01588_wp
12263# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12264 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
12265# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12266 case default
12267# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12268 call s_int_to_str(patch_id, istr)
12269# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12270 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
12271# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12272 end select
12273 end if
12274 end if
12275 end do
12276 if (allocated(stored_values)) then
12277# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12278#ifdef MFC_DEBUG
12279# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12280 block
12281# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12282 use iso_fortran_env, only: output_unit
12283# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12284
12285# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12286 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(stored_values)'
12287# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12288
12289# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12290 call flush (output_unit)
12291# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12292 end block
12293# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12294#endif
12295# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12296
12297# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12298#if defined(MFC_OpenACC)
12299# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12300!$acc exit data delete(stored_values)
12301# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12302#elif defined(MFC_OpenMP)
12303# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12304!$omp target exit data map(release:stored_values)
12305# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12306#endif
12307# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12308 deallocate (stored_values)
12309# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12310#ifdef MFC_DEBUG
12311# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12312 block
12313# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12314 use iso_fortran_env, only: output_unit
12315# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12316
12317# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12318 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(x_coords)'
12319# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12320
12321# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12322 call flush (output_unit)
12323# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12324 end block
12325# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12326#endif
12327# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12328
12329# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12330#if defined(MFC_OpenACC)
12331# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12332!$acc exit data delete(x_coords)
12333# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12334#elif defined(MFC_OpenMP)
12335# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12336!$omp target exit data map(release:x_coords)
12337# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12338#endif
12339# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12340 deallocate (x_coords)
12341# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12342 end if
12343# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12344
12345# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12346 if (allocated(y_coords)) then
12347# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12348#ifdef MFC_DEBUG
12349# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12350 block
12351# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12352 use iso_fortran_env, only: output_unit
12353# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12354
12355# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12356 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(y_coords)'
12357# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12358
12359# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12360 call flush (output_unit)
12361# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12362 end block
12363# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12364#endif
12365# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12366
12367# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12368#if defined(MFC_OpenACC)
12369# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12370!$acc exit data delete(y_coords)
12371# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12372#elif defined(MFC_OpenMP)
12373# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12374!$omp target exit data map(release:y_coords)
12375# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12376#endif
12377# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12378 deallocate (y_coords)
12379# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12380 end if
12381
12382 end subroutine s_icpp_1d_bubble_pulse
12383
12384 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
12385 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
12386 !! max(R,0). If modal_clip_r_to_min, R = max(R, modal_r_min). Exponential (modal_use_exp_form true): R = radius*exp(sum);
12387 !! coefficients are relative (dimensionless).
12388 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
12389
12390 integer, intent(in) :: patch_id
12391
12392#ifdef MFC_MIXED_PRECISION
12393 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12394#else
12395 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12396#endif
12397 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12398 real(wp) :: r, theta, R_boundary, sum_series
12399 integer :: i, j, nn
12400
12401 x_centroid = patch_icpp(patch_id)%x_centroid
12402 y_centroid = patch_icpp(patch_id)%y_centroid
12403 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12404 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12405 eta = 1._wp
12406
12407 do j = 0, n
12408 do i = 0, m
12409 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
12410 if (r < small_radius) then
12411 theta = 0._wp
12412 else
12413 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
12414 end if
12415 sum_series = 0._wp
12416 do nn = 1, max_2d_fourier_modes
12417 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
12418 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
12419 end do
12420 if (patch_icpp(patch_id)%modal_use_exp_form) then
12421 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
12422 else
12423 r_boundary = patch_icpp(patch_id)%radius + sum_series
12424 r_boundary = max(r_boundary, 0._wp)
12425 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
12426 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
12427 end if
12428 end if
12429 if (patch_icpp(patch_id)%smoothen) then
12430 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy)*(r_boundary - r))
12431 end if
12432 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
12433 & 0) == smooth_patch_id) then
12434 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
12435 end if
12436 end do
12437 end do
12438
12439 end subroutine s_icpp_2d_modal
12440
12441 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
12442 !! atan2(y,x) relative to centroid.
12443 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
12444
12445 integer, intent(in) :: patch_id
12446
12447#ifdef MFC_MIXED_PRECISION
12448 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12449#else
12450 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12451#endif
12452 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12453 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
12454 integer :: i, j, k, ll, mm
12455
12456 x_centroid = patch_icpp(patch_id)%x_centroid
12457 y_centroid = patch_icpp(patch_id)%y_centroid
12458 z_centroid = patch_icpp(patch_id)%z_centroid
12459 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12460 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12461 eta_local = 1._wp
12462
12463 do k = 0, p
12464 do j = 0, n
12465 do i = 0, m
12466 if (grid_geometry == 3) then
12467 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12468 dx_loc = x_cc(i) - x_centroid
12469 dy_loc = cart_y - y_centroid
12470 dz_loc = cart_z - z_centroid
12471 else
12472 dx_loc = x_cc(i) - x_centroid
12473 dy_loc = y_cc(j) - y_centroid
12474 dz_loc = z_cc(k) - z_centroid
12475 end if
12476 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
12477 if (r < small_radius) then
12478 theta = 0._wp
12479 phi = 0._wp
12480 else
12481 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
12482 phi = atan2(dy_loc, dx_loc)
12483 end if
12484 r_surface = patch_icpp(patch_id)%radius
12485 do ll = 0, max_sph_harm_degree
12486 do mm = -ll, ll
12487 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
12488 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
12489 end do
12490 end do
12491 if (patch_icpp(patch_id)%smoothen) then
12492 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy, dz)*(r_surface - r))
12493 end if
12494 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12495 & k) == smooth_patch_id) then
12496 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
12497 end if
12498 end do
12499 end do
12500 end do
12501
12502 end subroutine s_icpp_3d_spherical_harmonic
12503
12504 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
12505 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
12506 !! its boundary.
12507 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
12508
12509 integer, intent(in) :: patch_id
12510
12511#ifdef MFC_MIXED_PRECISION
12512 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12513#else
12514 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12515#endif
12516 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12517
12518 ! Generic loop iterators
12519 integer :: i, j, k
12520 real(wp) :: radius
12521
12522 integer :: xRows, yRows, nRows, iix, iiy, max_files
12523# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12524 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12525# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12526 real(wp) :: x_len, x_step, y_len, y_step
12527# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12528 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12529# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12530 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
12531# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12532 real(wp) :: delta_x, delta_y
12533# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12534 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
12535# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12536 character(len=200) :: errmsg
12537# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12538 real(wp), allocatable :: stored_values(:,:,:)
12539# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12540 real(wp), allocatable :: x_coords(:), y_coords(:)
12541# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12542 logical :: files_loaded = .false.
12543# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12544 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12545# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12546 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
12547# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 character(len=20) :: file_num_str !< For storing the file number as a string
12549# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 character(len=20) :: zeros_part !< For the trailing zeros part
12551# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12552 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
12553 ! Place any declaration of intermediate variables here
12554# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12555 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12556# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12557 real(wp) :: eps
12558# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12559
12560# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12561 ! IGR Jets Arrays to stor position and radii of jets from input file
12562# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12563 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12564# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12565 ! Variables to describe initial condition of jet
12566# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12567 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12568# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12569 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
12570# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12571 real(wp), dimension(0:n,0:p) :: rcut_arr
12572# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12573 integer :: l, q, s !< Iterators for reading input files
12574# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12575 integer :: start, end !< Ints to keep track of position in file
12576# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12577 character(len=1000) :: line !< String to store line in file
12578# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12579 character(len=25) :: value !< String to store value in line
12580# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12581 integer :: NJet !< Number of jets
12582# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12583
12584# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12585 eps = 1e-9_wp
12586# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12587
12588# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12589 if (patch_icpp(patch_id)%hcid == 303) then
12590# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12591 eps_smooth = 3._wp
12592# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12593 open (unit=10, file="njet.txt", status="old", action="read")
12594# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12595 read (10, *) njet
12596# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12597 close (10)
12598# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12599
12600# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12601 allocate (y_th_arr(0:njet - 1))
12602# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12603 allocate (z_th_arr(0:njet - 1))
12604# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12605 allocate (r_th_arr(0:njet - 1))
12606# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12607
12608# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12609 open (unit=10, file="jets.csv", status="old", action="read")
12610# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12611 do q = 0, njet - 1
12612# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12613 read (10, '(A)') line ! Read a full line as a string
12614# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12615 start = 1
12616# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12617
12618# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12619 do l = 0, 2
12620# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12621 end = index(line(start:), ',') ! Find the next comma
12622# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12623 if (end == 0) then
12624# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12625 value = trim(adjustl(line(start:))) ! Last value in the line
12626# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12627 else
12628# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12629 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12630# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12631 start = start + end ! Move to next value
12632# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12633 end if
12634# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12635 if (l == 0) then
12636# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12637 read (value, *) y_th_arr(q) ! Convert string to numeric value
12638# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12639 else if (l == 1) then
12640# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12641 read (value, *) z_th_arr(q)
12642# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12643 else
12644# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12645 read (value, *) r_th_arr(q)
12646# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12647 end if
12648# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12649 end do
12650# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12651 end do
12652# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12653 close (10)
12654# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12655
12656# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12657 do q = 0, p
12658# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12659 do l = 0, n
12660# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12661 rcut = 0._wp
12662# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12663 do s = 0, njet - 1
12664# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12665 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12666# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12667 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12668# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12669 end do
12670# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12671 rcut_arr(l, q) = rcut
12672# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12673 end do
12674# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12675 end do
12676# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12677 end if
12678
12679 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
12680
12681 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
12682 x_centroid = patch_icpp(patch_id)%x_centroid
12683 y_centroid = patch_icpp(patch_id)%y_centroid
12684 z_centroid = patch_icpp(patch_id)%z_centroid
12685 radius = patch_icpp(patch_id)%radius
12686 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12687 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12688
12689 ! Initialize eta=1; modified if smoothing is enabled
12690 eta = 1._wp
12691
12692 ! Assign patch vars if cell is covered and patch has write permission
12693 do k = 0, p
12694 do j = 0, n
12695 do i = 0, m
12696 if (grid_geometry == 3) then
12697 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12698 else
12699 cart_y = y_cc(j)
12700 cart_z = z_cc(k)
12701 end if
12702
12703 if (patch_icpp(patch_id)%smoothen) then
12704 eta = tanh(smooth_coeff/min(dx, dy, &
12705 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) &
12706 & - radius))*(-0.5_wp) + 0.5_wp
12707 end if
12708
12709 if ((((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2) &
12710 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12711 & k) == smooth_patch_id) then
12712 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
12713
12714
12715 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12716 select case (patch_icpp(patch_id)%hcid)
12717# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 case (300) ! Rayleigh-Taylor instability
12719# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 rhoh = 3._wp
12721# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722 rhol = 1._wp
12723# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 pref = 1.e5_wp
12725# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726 pint = pref
12727# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 h = 0.7_wp
12729# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 lam = 0.2_wp
12731# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732 wl = 2._wp*pi/lam
12733# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734 amp = 0.025_wp/wl
12735# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736
12737# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
12739# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740
12741# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12743# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744
12745# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746 if (alph < eps) alph = eps
12747# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748 if (alph > 1._wp - eps) alph = 1._wp - eps
12749# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750
12751# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752 if (y_cc(j) > inth) then
12753# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12755# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12757# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12759# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12761# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12763# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764 else
12765# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12767# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12769# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12771# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12773# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12775# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12777# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778 end if
12779# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12781# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 h = 0.0_wp
12783# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 lam = 1.0_wp
12785# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786 amp = patch_icpp(patch_id)%a(2)
12787# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12789# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790 if (x_cc(i) > inth) then
12791# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12793# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12795# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
12797# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12799# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12801# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802 end if
12803# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804 case (302) ! 3D Jet with IGR
12805# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 ux_th = 10*sqrt(1.4*0.4)
12807# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808 ux_am = 0.0*sqrt(1.4)
12809# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 p_th = 2.0_wp
12811# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812 p_am = 1.0_wp
12813# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 rho_th = 1._wp
12815# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816 rho_am = 1._wp
12817# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818 y_th = 0.0_wp
12819# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 z_th = 0.0_wp
12821# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822 r_th = 1._wp
12823# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824 eps_smooth = 1._wp
12825# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826 eps = 1e-6
12827# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828
12829# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12831# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832 rcut = f_cut_on(r - r_th, eps_smooth)
12833# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834 xcut = f_cut_on(x_cc(i), eps_smooth)
12835# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836
12837# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12839# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12841# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12843# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844
12845# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846 if (num_fluids == 1) then
12847# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12849# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850 else
12851# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12853# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12855# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
12857# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858 end if
12859# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860
12861# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12863# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864 case (303) ! 3D Multijet
12865# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 eps_smooth = 3.0_wp
12867# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868 ux_th = 10*sqrt(1.4*0.4)
12869# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870 ux_am = 2.5*sqrt(1.4*0.4)
12871# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872 p_th = 0.8_wp
12873# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874 p_am = 0.4_wp
12875# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876 rho_th = 1._wp
12877# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878 rho_am = 1._wp
12879# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880 eps = 1e-6
12881# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882
12883# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884 rcut = rcut_arr(j, k)
12885# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886 xcut = f_cut_on(x_cc(i), eps_smooth)
12887# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888
12889# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12891# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12893# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12895# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896
12897# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898 if (num_fluids == 1) then
12899# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12901# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902 else
12903# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12905# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12907# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
12909# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910 end if
12911# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912
12913# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12915# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 case (370) ! 3D extrusion of 2D profile from external data
12917# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12919# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 if (.not. files_loaded) then
12921# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12923# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 do f = 1, max_files
12925# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926 write (file_num_str, '(I0)') f
12927# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
12929# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930 end do
12931# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932
12933# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12934 ! Common file reading setup
12935# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12937# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12939# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940
12941# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 select case (num_dims)
12943# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 case (1, 2) ! 1D and 2D cases are similar
12945# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946 ! Count lines
12947# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 line_count = 0
12949# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950 do
12951# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12953# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954 if (ios2 /= 0) exit
12955# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956 line_count = line_count + 1
12957# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958 end do
12959# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960 close (unit2)
12961# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962
12963# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964 xrows = line_count
12965# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966 yrows = 1
12967# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 index_x = 0
12969# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970 if (num_dims == 2) index_x = i
12971# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972#ifdef MFC_DEBUG
12973# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974 block
12975# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976 use iso_fortran_env, only: output_unit
12977# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978
12979# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980 print *, 'm_icpp_patches.fpp:1020: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12981# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982
12983# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984 call flush (output_unit)
12985# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986 end block
12987# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988#endif
12989# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12991# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992
12993# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994
12995# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996
12997# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998#if defined(MFC_OpenACC)
12999# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000!$acc enter data create(x_coords, stored_values)
13001# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002#elif defined(MFC_OpenMP)
13003# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004!$omp target enter data map(always,alloc:x_coords, stored_values)
13005# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006#endif
13007# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008
13009# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 ! Read data from all files
13011# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012 do f = 1, max_files
13013# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13015# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13017# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018
13019# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020 do iter = 1, xrows
13021# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13023# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13025# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 end do
13027# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 close (unit)
13029# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030 end do
13031# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032
13033# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034 ! Calculate offsets
13035# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036 domain_xstart = x_coords(1)
13037# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 x_step = x_cc(1) - x_cc(0)
13039# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
13041# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042 global_offset_x = nint(abs(delta_x)/x_step)
13043# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044 case (3) ! 3D case - determine grid structure
13045# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13046 ! Find yRows by counting rows with same x
13047# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13048 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13049# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13050 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13051# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13052
13053# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13054 yrows = 1
13055# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13056 do
13057# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13058 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13059# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13060 if (ios2 /= 0) exit
13061# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13062 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13063# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13064 yrows = yrows + 1
13065# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13066 else
13067# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13068 exit
13069# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13070 end if
13071# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13072 end do
13073# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13074 close (unit2)
13075# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13076
13077# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13078 ! Count total rows
13079# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13080 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13081# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13082 nrows = 0
13083# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13084 do
13085# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13086 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13087# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13088 if (ios2 /= 0) exit
13089# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13090 nrows = nrows + 1
13091# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13092 end do
13093# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13094 close (unit2)
13095# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13096
13097# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13098 xrows = nrows/yrows
13099# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13100#ifdef MFC_DEBUG
13101# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13102 block
13103# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13104 use iso_fortran_env, only: output_unit
13105# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13106
13107# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13108 print *, 'm_icpp_patches.fpp:1020: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13109# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13110
13111# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13112 call flush (output_unit)
13113# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13114 end block
13115# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13116#endif
13117# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13118 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13119# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13120
13121# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13122
13123# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13124
13125# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13126
13127# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13128#if defined(MFC_OpenACC)
13129# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13130!$acc enter data create(x_coords, y_coords, stored_values)
13131# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13132#elif defined(MFC_OpenMP)
13133# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13134!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13135# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13136#endif
13137# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13138 index_x = i
13139# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13140 index_y = j
13141# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13142
13143# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13144 ! Read all files
13145# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13146 do f = 1, max_files
13147# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13148 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13149# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13150 if (ios /= 0) then
13151# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13152 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13153# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13154 cycle
13155# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13156 end if
13157# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13158
13159# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13160 iter = 0
13161# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13162 do iix = 1, xrows
13163# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13164 do iiy = 1, yrows
13165# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13166 iter = iter + 1
13167# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13168 if (f == 1) then
13169# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13170 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13171# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13172 else
13173# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13174 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13175# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13176 end if
13177# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13178 if (ios /= 0) call s_mpi_abort("Error reading data")
13179# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13180 end do
13181# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13182 end do
13183# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13184 close (unit)
13185# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13186 end do
13187# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13188
13189# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13190 ! Calculate offsets
13191# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13192 x_step = x_cc(1) - x_cc(0)
13193# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13194 y_step = y_cc(1) - y_cc(0)
13195# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13196 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13197# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13198 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13199# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13200 global_offset_x = nint(abs(delta_x)/x_step)
13201# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13202 global_offset_y = nint(abs(delta_y)/y_step)
13203# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13204 end select
13205# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13206
13207# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13208 files_loaded = .true.
13209# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13210 end if
13211# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13212
13213# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13214 ! Data assignment
13215# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13216 select case (num_dims)
13217# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13218 case (1)
13219# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13220 idx = i + 1 + global_offset_x
13221# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13222 do f = 1, sys_size
13223# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13224 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13225# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13226 end do
13227# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13228 case (2)
13229# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13230 idx = i + 1 + global_offset_x - index_x
13231# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13232 do f = 1, sys_size - 1
13233# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13234 jump = merge(1, 0, f >= eqn_idx%mom%end)
13235# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13236 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13237# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13238 end do
13239# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13240 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13241# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242 case (3)
13243# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244 idx = i + 1 + global_offset_x - index_x
13245# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246 idy = j + 1 + global_offset_y - index_y
13247# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248 do f = 1, sys_size - 1
13249# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250 jump = merge(1, 0, f >= eqn_idx%mom%end)
13251# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13253# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254 end do
13255# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13256 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13257# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13258 end select
13259# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13260 case (380) ! Taylor-Green vortex
13261# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13262 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
13263# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13264 ! geometry 9
13265# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13266 mach = 0.1
13267# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13268 if (patch_id == 1) then
13269# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13270 q_prim_vf(eqn_idx%E)%sf(i, j, &
13271# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13272 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
13273# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13274 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
13275# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13276 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
13277# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13278 end if
13279# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13280 case default
13281# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13282 call s_int_to_str(patch_id, istr)
13283# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13284 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
13285# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13286 end select
13287 end if
13288 end if
13289 end do
13290 end do
13291 end do
13292 if (allocated(stored_values)) then
13293# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13294#ifdef MFC_DEBUG
13295# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13296 block
13297# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13298 use iso_fortran_env, only: output_unit
13299# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13300
13301# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13302 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(stored_values)'
13303# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13304
13305# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13306 call flush (output_unit)
13307# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308 end block
13309# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310#endif
13311# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312
13313# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314#if defined(MFC_OpenACC)
13315# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316!$acc exit data delete(stored_values)
13317# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318#elif defined(MFC_OpenMP)
13319# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320!$omp target exit data map(release:stored_values)
13321# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322#endif
13323# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324 deallocate (stored_values)
13325# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326#ifdef MFC_DEBUG
13327# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328 block
13329# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330 use iso_fortran_env, only: output_unit
13331# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332
13333# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(x_coords)'
13335# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336
13337# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338 call flush (output_unit)
13339# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340 end block
13341# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342#endif
13343# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13344
13345# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13346#if defined(MFC_OpenACC)
13347# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13348!$acc exit data delete(x_coords)
13349# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13350#elif defined(MFC_OpenMP)
13351# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13352!$omp target exit data map(release:x_coords)
13353# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13354#endif
13355# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13356 deallocate (x_coords)
13357# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13358 end if
13359# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13360
13361# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13362 if (allocated(y_coords)) then
13363# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13364#ifdef MFC_DEBUG
13365# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13366 block
13367# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13368 use iso_fortran_env, only: output_unit
13369# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13370
13371# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13372 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(y_coords)'
13373# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13374
13375# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13376 call flush (output_unit)
13377# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13378 end block
13379# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13380#endif
13381# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13382
13383# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13384#if defined(MFC_OpenACC)
13385# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13386!$acc exit data delete(y_coords)
13387# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13388#elif defined(MFC_OpenMP)
13389# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13390!$omp target exit data map(release:y_coords)
13391# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13392#endif
13393# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13394 deallocate (y_coords)
13395# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13396 end if
13397
13398 end subroutine s_icpp_sphere
13399
13400 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
13401 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
13402 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
13403 !! allow for the smearing of its boundaries.
13404 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
13405
13406 integer, intent(in) :: patch_id
13407
13408#ifdef MFC_MIXED_PRECISION
13409 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13410#else
13411 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13412#endif
13413 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13414 integer :: i, j, k !< Generic loop iterators
13415
13416 integer :: xRows, yRows, nRows, iix, iiy, max_files
13417# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13418 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13419# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13420 real(wp) :: x_len, x_step, y_len, y_step
13421# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13422 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13423# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13424 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
13425# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426 real(wp) :: delta_x, delta_y
13427# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
13429# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 character(len=200) :: errmsg
13431# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13432 real(wp), allocatable :: stored_values(:,:,:)
13433# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13434 real(wp), allocatable :: x_coords(:), y_coords(:)
13435# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13436 logical :: files_loaded = .false.
13437# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13438 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13439# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13440 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
13441# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 character(len=20) :: file_num_str !< For storing the file number as a string
13443# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 character(len=20) :: zeros_part !< For the trailing zeros part
13445# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13446 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
13447 ! Place any declaration of intermediate variables here
13448# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13449 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13450# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13451 real(wp) :: eps
13452# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13453
13454# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13455 ! IGR Jets Arrays to stor position and radii of jets from input file
13456# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13457 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13458# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13459 ! Variables to describe initial condition of jet
13460# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13461 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13462# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13463 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
13464# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13465 real(wp), dimension(0:n,0:p) :: rcut_arr
13466# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13467 integer :: l, q, s !< Iterators for reading input files
13468# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13469 integer :: start, end !< Ints to keep track of position in file
13470# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13471 character(len=1000) :: line !< String to store line in file
13472# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13473 character(len=25) :: value !< String to store value in line
13474# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13475 integer :: NJet !< Number of jets
13476# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13477
13478# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13479 eps = 1e-9_wp
13480# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13481
13482# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13483 if (patch_icpp(patch_id)%hcid == 303) then
13484# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13485 eps_smooth = 3._wp
13486# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13487 open (unit=10, file="njet.txt", status="old", action="read")
13488# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13489 read (10, *) njet
13490# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13491 close (10)
13492# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13493
13494# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13495 allocate (y_th_arr(0:njet - 1))
13496# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13497 allocate (z_th_arr(0:njet - 1))
13498# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13499 allocate (r_th_arr(0:njet - 1))
13500# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13501
13502# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13503 open (unit=10, file="jets.csv", status="old", action="read")
13504# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13505 do q = 0, njet - 1
13506# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13507 read (10, '(A)') line ! Read a full line as a string
13508# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13509 start = 1
13510# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13511
13512# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13513 do l = 0, 2
13514# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13515 end = index(line(start:), ',') ! Find the next comma
13516# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13517 if (end == 0) then
13518# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13519 value = trim(adjustl(line(start:))) ! Last value in the line
13520# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13521 else
13522# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13523 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13524# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13525 start = start + end ! Move to next value
13526# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13527 end if
13528# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13529 if (l == 0) then
13530# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13531 read (value, *) y_th_arr(q) ! Convert string to numeric value
13532# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13533 else if (l == 1) then
13534# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13535 read (value, *) z_th_arr(q)
13536# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13537 else
13538# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13539 read (value, *) r_th_arr(q)
13540# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13541 end if
13542# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13543 end do
13544# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13545 end do
13546# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13547 close (10)
13548# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13549
13550# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13551 do q = 0, p
13552# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13553 do l = 0, n
13554# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13555 rcut = 0._wp
13556# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13557 do s = 0, njet - 1
13558# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13559 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13560# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13561 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13562# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13563 end do
13564# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13565 rcut_arr(l, q) = rcut
13566# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13567 end do
13568# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13569 end do
13570# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13571 end if
13572
13573 ! Transferring the cuboid's centroid and length information
13574 x_centroid = patch_icpp(patch_id)%x_centroid
13575 y_centroid = patch_icpp(patch_id)%y_centroid
13576 z_centroid = patch_icpp(patch_id)%z_centroid
13577 length_x = patch_icpp(patch_id)%length_x
13578 length_y = patch_icpp(patch_id)%length_y
13579 length_z = patch_icpp(patch_id)%length_z
13580
13581 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
13582 x_boundary%beg = x_centroid - 0.5_wp*length_x
13583 x_boundary%end = x_centroid + 0.5_wp*length_x
13584 y_boundary%beg = y_centroid - 0.5_wp*length_y
13585 y_boundary%end = y_centroid + 0.5_wp*length_y
13586 z_boundary%beg = z_centroid - 0.5_wp*length_z
13587 z_boundary%end = z_centroid + 0.5_wp*length_z
13588
13589 ! Set eta=1 (no smoothing for this patch type)
13590 eta = 1._wp
13591
13592 ! Assign patch vars if cell is covered and patch has write permission
13593 do k = 0, p
13594 do j = 0, n
13595 do i = 0, m
13596 if (grid_geometry == 3) then
13597 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
13598 else
13599 cart_y = y_cc(j)
13600 cart_z = z_cc(k)
13601 end if
13602
13603 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= cart_y &
13604 & .and. y_boundary%end >= cart_y .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) then
13605 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
13606 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
13607
13608
13609 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13610 select case (patch_icpp(patch_id)%hcid)
13611# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612 case (300) ! Rayleigh-Taylor instability
13613# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614 rhoh = 3._wp
13615# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 rhol = 1._wp
13617# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 pref = 1.e5_wp
13619# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 pint = pref
13621# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622 h = 0.7_wp
13623# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 lam = 0.2_wp
13625# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626 wl = 2._wp*pi/lam
13627# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628 amp = 0.025_wp/wl
13629# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630
13631# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
13633# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634
13635# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13637# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638
13639# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640 if (alph < eps) alph = eps
13641# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642 if (alph > 1._wp - eps) alph = 1._wp - eps
13643# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644
13645# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 if (y_cc(j) > inth) then
13647# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13649# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13651# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13653# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13655# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13657# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 else
13659# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13661# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13663# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13665# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13667# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13669# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13671# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672 end if
13673# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13675# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676 h = 0.0_wp
13677# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 lam = 1.0_wp
13679# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 amp = patch_icpp(patch_id)%a(2)
13681# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13683# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684 if (x_cc(i) > inth) then
13685# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13687# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13689# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
13691# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13693# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13695# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696 end if
13697# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698 case (302) ! 3D Jet with IGR
13699# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700 ux_th = 10*sqrt(1.4*0.4)
13701# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702 ux_am = 0.0*sqrt(1.4)
13703# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704 p_th = 2.0_wp
13705# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 p_am = 1.0_wp
13707# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 rho_th = 1._wp
13709# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710 rho_am = 1._wp
13711# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712 y_th = 0.0_wp
13713# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714 z_th = 0.0_wp
13715# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716 r_th = 1._wp
13717# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718 eps_smooth = 1._wp
13719# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720 eps = 1e-6
13721# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722
13723# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13725# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726 rcut = f_cut_on(r - r_th, eps_smooth)
13727# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728 xcut = f_cut_on(x_cc(i), eps_smooth)
13729# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730
13731# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13733# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13735# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13737# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738
13739# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740 if (num_fluids == 1) then
13741# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13743# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 else
13745# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13747# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13749# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
13751# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752 end if
13753# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754
13755# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13757# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 case (303) ! 3D Multijet
13759# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760 eps_smooth = 3.0_wp
13761# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 ux_th = 10*sqrt(1.4*0.4)
13763# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 ux_am = 2.5*sqrt(1.4*0.4)
13765# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766 p_th = 0.8_wp
13767# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768 p_am = 0.4_wp
13769# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770 rho_th = 1._wp
13771# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772 rho_am = 1._wp
13773# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774 eps = 1e-6
13775# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776
13777# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778 rcut = rcut_arr(j, k)
13779# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780 xcut = f_cut_on(x_cc(i), eps_smooth)
13781# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782
13783# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13785# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13787# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13789# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790
13791# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 if (num_fluids == 1) then
13793# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13795# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796 else
13797# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13799# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13801# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
13803# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804 end if
13805# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806
13807# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13809# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810 case (370) ! 3D extrusion of 2D profile from external data
13811# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13813# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814 if (.not. files_loaded) then
13815# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13817# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818 do f = 1, max_files
13819# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820 write (file_num_str, '(I0)') f
13821# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
13823# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824 end do
13825# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13826
13827# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13828 ! Common file reading setup
13829# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13830 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13831# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13832 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13833# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834
13835# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836 select case (num_dims)
13837# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 case (1, 2) ! 1D and 2D cases are similar
13839# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840 ! Count lines
13841# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842 line_count = 0
13843# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844 do
13845# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13847# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848 if (ios2 /= 0) exit
13849# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850 line_count = line_count + 1
13851# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852 end do
13853# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854 close (unit2)
13855# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856
13857# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858 xrows = line_count
13859# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860 yrows = 1
13861# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862 index_x = 0
13863# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864 if (num_dims == 2) index_x = i
13865# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866#ifdef MFC_DEBUG
13867# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868 block
13869# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870 use iso_fortran_env, only: output_unit
13871# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872
13873# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874 print *, 'm_icpp_patches.fpp:1086: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13875# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876
13877# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878 call flush (output_unit)
13879# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880 end block
13881# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882#endif
13883# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13885# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886
13887# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888
13889# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890
13891# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892#if defined(MFC_OpenACC)
13893# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894!$acc enter data create(x_coords, stored_values)
13895# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896#elif defined(MFC_OpenMP)
13897# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898!$omp target enter data map(always,alloc:x_coords, stored_values)
13899# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900#endif
13901# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902
13903# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904 ! Read data from all files
13905# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906 do f = 1, max_files
13907# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13909# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13911# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912
13913# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914 do iter = 1, xrows
13915# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13917# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13919# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920 end do
13921# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922 close (unit)
13923# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924 end do
13925# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926
13927# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928 ! Calculate offsets
13929# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930 domain_xstart = x_coords(1)
13931# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932 x_step = x_cc(1) - x_cc(0)
13933# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
13935# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936 global_offset_x = nint(abs(delta_x)/x_step)
13937# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938 case (3) ! 3D case - determine grid structure
13939# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 ! Find yRows by counting rows with same x
13941# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13943# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13945# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946
13947# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 yrows = 1
13949# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 do
13951# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13953# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954 if (ios2 /= 0) exit
13955# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13957# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 yrows = yrows + 1
13959# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 else
13961# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962 exit
13963# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964 end if
13965# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966 end do
13967# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968 close (unit2)
13969# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970
13971# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972 ! Count total rows
13973# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13975# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 nrows = 0
13977# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 do
13979# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13981# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 if (ios2 /= 0) exit
13983# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13984 nrows = nrows + 1
13985# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13986 end do
13987# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13988 close (unit2)
13989# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13990
13991# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13992 xrows = nrows/yrows
13993# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13994#ifdef MFC_DEBUG
13995# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13996 block
13997# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13998 use iso_fortran_env, only: output_unit
13999# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14000
14001# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14002 print *, 'm_icpp_patches.fpp:1086: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14003# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14004
14005# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14006 call flush (output_unit)
14007# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14008 end block
14009# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14010#endif
14011# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14012 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14013# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14014
14015# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14016
14017# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14018
14019# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14020
14021# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14022#if defined(MFC_OpenACC)
14023# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14024!$acc enter data create(x_coords, y_coords, stored_values)
14025# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14026#elif defined(MFC_OpenMP)
14027# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14028!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14029# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14030#endif
14031# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14032 index_x = i
14033# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14034 index_y = j
14035# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14036
14037# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14038 ! Read all files
14039# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14040 do f = 1, max_files
14041# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14042 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14043# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14044 if (ios /= 0) then
14045# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14046 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14047# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14048 cycle
14049# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14050 end if
14051# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14052
14053# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14054 iter = 0
14055# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14056 do iix = 1, xrows
14057# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14058 do iiy = 1, yrows
14059# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14060 iter = iter + 1
14061# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14062 if (f == 1) then
14063# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14064 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14065# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14066 else
14067# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14068 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14069# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14070 end if
14071# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14072 if (ios /= 0) call s_mpi_abort("Error reading data")
14073# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14074 end do
14075# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14076 end do
14077# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14078 close (unit)
14079# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14080 end do
14081# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14082
14083# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14084 ! Calculate offsets
14085# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14086 x_step = x_cc(1) - x_cc(0)
14087# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14088 y_step = y_cc(1) - y_cc(0)
14089# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14090 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14091# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14092 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14093# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14094 global_offset_x = nint(abs(delta_x)/x_step)
14095# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14096 global_offset_y = nint(abs(delta_y)/y_step)
14097# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14098 end select
14099# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14100
14101# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14102 files_loaded = .true.
14103# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14104 end if
14105# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14106
14107# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14108 ! Data assignment
14109# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14110 select case (num_dims)
14111# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14112 case (1)
14113# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14114 idx = i + 1 + global_offset_x
14115# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14116 do f = 1, sys_size
14117# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14118 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14119# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14120 end do
14121# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14122 case (2)
14123# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14124 idx = i + 1 + global_offset_x - index_x
14125# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14126 do f = 1, sys_size - 1
14127# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14128 jump = merge(1, 0, f >= eqn_idx%mom%end)
14129# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14130 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14131# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14132 end do
14133# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14134 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14135# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14136 case (3)
14137# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14138 idx = i + 1 + global_offset_x - index_x
14139# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14140 idy = j + 1 + global_offset_y - index_y
14141# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14142 do f = 1, sys_size - 1
14143# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14144 jump = merge(1, 0, f >= eqn_idx%mom%end)
14145# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14146 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14147# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14148 end do
14149# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14150 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
14151# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14152 end select
14153# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14154 case (380) ! Taylor-Green vortex
14155# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14156 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
14157# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14158 ! geometry 9
14159# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14160 mach = 0.1
14161# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14162 if (patch_id == 1) then
14163# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14164 q_prim_vf(eqn_idx%E)%sf(i, j, &
14165# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14166 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
14167# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14168 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14169# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14170 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14171# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14172 end if
14173# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14174 case default
14175# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14176 call s_int_to_str(patch_id, istr)
14177# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14178 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14179# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14180 end select
14181 end if
14182
14183 ! Updating the patch identities bookkeeping variable
14184 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14185 end if
14186 end if
14187 end do
14188 end do
14189 end do
14190 if (allocated(stored_values)) then
14191# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14192#ifdef MFC_DEBUG
14193# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14194 block
14195# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14196 use iso_fortran_env, only: output_unit
14197# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14198
14199# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14200 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(stored_values)'
14201# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14202
14203# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14204 call flush (output_unit)
14205# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14206 end block
14207# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14208#endif
14209# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14210
14211# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14212#if defined(MFC_OpenACC)
14213# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14214!$acc exit data delete(stored_values)
14215# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14216#elif defined(MFC_OpenMP)
14217# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14218!$omp target exit data map(release:stored_values)
14219# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14220#endif
14221# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14222 deallocate (stored_values)
14223# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14224#ifdef MFC_DEBUG
14225# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14226 block
14227# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14228 use iso_fortran_env, only: output_unit
14229# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14230
14231# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14232 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(x_coords)'
14233# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14234
14235# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14236 call flush (output_unit)
14237# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14238 end block
14239# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14240#endif
14241# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14242
14243# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14244#if defined(MFC_OpenACC)
14245# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14246!$acc exit data delete(x_coords)
14247# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14248#elif defined(MFC_OpenMP)
14249# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14250!$omp target exit data map(release:x_coords)
14251# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14252#endif
14253# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14254 deallocate (x_coords)
14255# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14256 end if
14257# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14258
14259# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14260 if (allocated(y_coords)) then
14261# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14262#ifdef MFC_DEBUG
14263# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14264 block
14265# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14266 use iso_fortran_env, only: output_unit
14267# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14268
14269# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14270 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(y_coords)'
14271# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14272
14273# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14274 call flush (output_unit)
14275# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14276 end block
14277# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14278#endif
14279# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14280
14281# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14282#if defined(MFC_OpenACC)
14283# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14284!$acc exit data delete(y_coords)
14285# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14286#elif defined(MFC_OpenMP)
14287# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14288!$omp target exit data map(release:y_coords)
14289# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14290#endif
14291# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14292 deallocate (y_coords)
14293# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14294 end if
14295
14296 end subroutine s_icpp_cuboid
14297
14298 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
14299 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
14300 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
14301 !! allow for the smoothing of its lateral boundary.
14302 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
14303
14304 integer, intent(in) :: patch_id
14305
14306#ifdef MFC_MIXED_PRECISION
14307 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14308#else
14309 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14310#endif
14311 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14312 integer :: i, j, k !< Generic loop iterators
14313 real(wp) :: radius
14314
14315 integer :: xRows, yRows, nRows, iix, iiy, max_files
14316# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14318# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 real(wp) :: x_len, x_step, y_len, y_step
14320# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14322# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
14324# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325 real(wp) :: delta_x, delta_y
14326# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14327 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
14328# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14329 character(len=200) :: errmsg
14330# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14331 real(wp), allocatable :: stored_values(:,:,:)
14332# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14333 real(wp), allocatable :: x_coords(:), y_coords(:)
14334# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14335 logical :: files_loaded = .false.
14336# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14337 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14338# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14339 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
14340# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341 character(len=20) :: file_num_str !< For storing the file number as a string
14342# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 character(len=20) :: zeros_part !< For the trailing zeros part
14344# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14345 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
14346 ! Place any declaration of intermediate variables here
14347# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14348 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14349# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14350 real(wp) :: eps
14351# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14352
14353# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14354 ! IGR Jets Arrays to stor position and radii of jets from input file
14355# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14356 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14357# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14358 ! Variables to describe initial condition of jet
14359# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14360 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14361# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14362 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
14363# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14364 real(wp), dimension(0:n,0:p) :: rcut_arr
14365# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14366 integer :: l, q, s !< Iterators for reading input files
14367# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14368 integer :: start, end !< Ints to keep track of position in file
14369# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14370 character(len=1000) :: line !< String to store line in file
14371# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14372 character(len=25) :: value !< String to store value in line
14373# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14374 integer :: NJet !< Number of jets
14375# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14376
14377# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14378 eps = 1e-9_wp
14379# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14380
14381# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14382 if (patch_icpp(patch_id)%hcid == 303) then
14383# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14384 eps_smooth = 3._wp
14385# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14386 open (unit=10, file="njet.txt", status="old", action="read")
14387# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14388 read (10, *) njet
14389# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14390 close (10)
14391# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14392
14393# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14394 allocate (y_th_arr(0:njet - 1))
14395# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14396 allocate (z_th_arr(0:njet - 1))
14397# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14398 allocate (r_th_arr(0:njet - 1))
14399# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14400
14401# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14402 open (unit=10, file="jets.csv", status="old", action="read")
14403# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14404 do q = 0, njet - 1
14405# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14406 read (10, '(A)') line ! Read a full line as a string
14407# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14408 start = 1
14409# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14410
14411# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14412 do l = 0, 2
14413# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14414 end = index(line(start:), ',') ! Find the next comma
14415# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14416 if (end == 0) then
14417# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14418 value = trim(adjustl(line(start:))) ! Last value in the line
14419# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14420 else
14421# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14422 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14423# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14424 start = start + end ! Move to next value
14425# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14426 end if
14427# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14428 if (l == 0) then
14429# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14430 read (value, *) y_th_arr(q) ! Convert string to numeric value
14431# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14432 else if (l == 1) then
14433# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14434 read (value, *) z_th_arr(q)
14435# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14436 else
14437# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14438 read (value, *) r_th_arr(q)
14439# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14440 end if
14441# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14442 end do
14443# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14444 end do
14445# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14446 close (10)
14447# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14448
14449# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14450 do q = 0, p
14451# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14452 do l = 0, n
14453# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14454 rcut = 0._wp
14455# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14456 do s = 0, njet - 1
14457# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14458 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14459# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14460 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14461# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14462 end do
14463# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14464 rcut_arr(l, q) = rcut
14465# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14466 end do
14467# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14468 end do
14469# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14470 end if
14471
14472 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
14473 ! information
14474 x_centroid = patch_icpp(patch_id)%x_centroid
14475 y_centroid = patch_icpp(patch_id)%y_centroid
14476 z_centroid = patch_icpp(patch_id)%z_centroid
14477 length_x = patch_icpp(patch_id)%length_x
14478 length_y = patch_icpp(patch_id)%length_y
14479 length_z = patch_icpp(patch_id)%length_z
14480 radius = patch_icpp(patch_id)%radius
14481 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14482 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14483
14484 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
14485 x_boundary%beg = x_centroid - 0.5_wp*length_x
14486 x_boundary%end = x_centroid + 0.5_wp*length_x
14487 y_boundary%beg = y_centroid - 0.5_wp*length_y
14488 y_boundary%end = y_centroid + 0.5_wp*length_y
14489 z_boundary%beg = z_centroid - 0.5_wp*length_z
14490 z_boundary%end = z_centroid + 0.5_wp*length_z
14491
14492 ! Initialize eta=1; modified if smoothing is enabled
14493 eta = 1._wp
14494
14495 ! Assign patch vars if cell is covered and patch has write permission
14496 do k = 0, p
14497 do j = 0, n
14498 do i = 0, m
14499 if (grid_geometry == 3) then
14500 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
14501 else
14502 cart_y = y_cc(j)
14503 cart_z = z_cc(k)
14504 end if
14505
14506 if (patch_icpp(patch_id)%smoothen) then
14507 if (.not. f_is_default(length_x)) then
14508 eta = tanh(smooth_coeff/min(dy, &
14509 & dz)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14510 & + 0.5_wp
14511 else if (.not. f_is_default(length_y)) then
14512 eta = tanh(smooth_coeff/min(dx, &
14513 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14514 & + 0.5_wp
14515 else
14516 eta = tanh(smooth_coeff/min(dx, &
14517 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
14518 & + 0.5_wp
14519 end if
14520 end if
14521
14522 if (((.not. f_is_default(length_x) .and. (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 &
14523 & .and. x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i)) .or. (.not. f_is_default(length_y) &
14524 & .and. (x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 .and. y_boundary%beg <= cart_y &
14525 & .and. y_boundary%end >= cart_y) .or. (.not. f_is_default(length_z) .and. (x_cc(i) - x_centroid)**2 &
14526 & + (cart_y - y_centroid)**2 <= radius**2 .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) &
14527 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
14528 & k) == smooth_patch_id) then
14529 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
14530
14531
14532 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14533 select case (patch_icpp(patch_id)%hcid)
14534# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14535 case (300) ! Rayleigh-Taylor instability
14536# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14537 rhoh = 3._wp
14538# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14539 rhol = 1._wp
14540# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14541 pref = 1.e5_wp
14542# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14543 pint = pref
14544# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14545 h = 0.7_wp
14546# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14547 lam = 0.2_wp
14548# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14549 wl = 2._wp*pi/lam
14550# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14551 amp = 0.025_wp/wl
14552# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14553
14554# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14555 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
14556# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14557
14558# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14559 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14560# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14561
14562# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14563 if (alph < eps) alph = eps
14564# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14565 if (alph > 1._wp - eps) alph = 1._wp - eps
14566# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14567
14568# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14569 if (y_cc(j) > inth) then
14570# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14571 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14572# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14573 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14574# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14575 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14576# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14577 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14578# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14579 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14580# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14581 else
14582# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14583 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14584# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14585 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14586# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14587 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14588# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14589 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14590# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14591 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14592# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14593 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14594# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14595 end if
14596# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14597 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14598# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14599 h = 0.0_wp
14600# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14601 lam = 1.0_wp
14602# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14603 amp = patch_icpp(patch_id)%a(2)
14604# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14605 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14606# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14607 if (x_cc(i) > inth) then
14608# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14609 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14610# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14611 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14612# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14613 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
14614# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14615 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14616# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14617 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14618# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14619 end if
14620# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14621 case (302) ! 3D Jet with IGR
14622# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14623 ux_th = 10*sqrt(1.4*0.4)
14624# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14625 ux_am = 0.0*sqrt(1.4)
14626# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14627 p_th = 2.0_wp
14628# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14629 p_am = 1.0_wp
14630# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14631 rho_th = 1._wp
14632# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14633 rho_am = 1._wp
14634# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14635 y_th = 0.0_wp
14636# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14637 z_th = 0.0_wp
14638# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14639 r_th = 1._wp
14640# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14641 eps_smooth = 1._wp
14642# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14643 eps = 1e-6
14644# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14645
14646# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14647 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14648# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14649 rcut = f_cut_on(r - r_th, eps_smooth)
14650# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14651 xcut = f_cut_on(x_cc(i), eps_smooth)
14652# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14653
14654# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14655 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14656# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14657 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14658# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14659 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14660# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14661
14662# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14663 if (num_fluids == 1) then
14664# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14665 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14666# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14667 else
14668# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14669 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14670# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14671 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14672# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14673 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
14674# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14675 end if
14676# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14677
14678# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14679 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14680# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14681 case (303) ! 3D Multijet
14682# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14683 eps_smooth = 3.0_wp
14684# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14685 ux_th = 10*sqrt(1.4*0.4)
14686# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14687 ux_am = 2.5*sqrt(1.4*0.4)
14688# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14689 p_th = 0.8_wp
14690# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14691 p_am = 0.4_wp
14692# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14693 rho_th = 1._wp
14694# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14695 rho_am = 1._wp
14696# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14697 eps = 1e-6
14698# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14699
14700# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14701 rcut = rcut_arr(j, k)
14702# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14703 xcut = f_cut_on(x_cc(i), eps_smooth)
14704# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14705
14706# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14707 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14708# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14709 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14710# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14711 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14712# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14713
14714# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14715 if (num_fluids == 1) then
14716# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14717 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14718# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14719 else
14720# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14721 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14722# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14723 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14724# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14725 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
14726# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14727 end if
14728# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14729
14730# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14731 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14732# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14733 case (370) ! 3D extrusion of 2D profile from external data
14734# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14735 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14736# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14737 if (.not. files_loaded) then
14738# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14739 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14740# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14741 do f = 1, max_files
14742# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14743 write (file_num_str, '(I0)') f
14744# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14745 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
14746# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14747 end do
14748# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14749
14750# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14751 ! Common file reading setup
14752# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14753 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14754# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14755 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14756# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14757
14758# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14759 select case (num_dims)
14760# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14761 case (1, 2) ! 1D and 2D cases are similar
14762# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14763 ! Count lines
14764# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14765 line_count = 0
14766# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14767 do
14768# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14769 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14770# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14771 if (ios2 /= 0) exit
14772# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14773 line_count = line_count + 1
14774# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14775 end do
14776# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14777 close (unit2)
14778# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14779
14780# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14781 xrows = line_count
14782# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14783 yrows = 1
14784# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14785 index_x = 0
14786# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14787 if (num_dims == 2) index_x = i
14788# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14789#ifdef MFC_DEBUG
14790# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14791 block
14792# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14793 use iso_fortran_env, only: output_unit
14794# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14795
14796# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14797 print *, 'm_icpp_patches.fpp:1181: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14798# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14799
14800# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14801 call flush (output_unit)
14802# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14803 end block
14804# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14805#endif
14806# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14807 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14808# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14809
14810# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14811
14812# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14813
14814# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14815#if defined(MFC_OpenACC)
14816# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14817!$acc enter data create(x_coords, stored_values)
14818# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14819#elif defined(MFC_OpenMP)
14820# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14821!$omp target enter data map(always,alloc:x_coords, stored_values)
14822# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14823#endif
14824# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14825
14826# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14827 ! Read data from all files
14828# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14829 do f = 1, max_files
14830# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14831 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14832# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14833 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14834# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14835
14836# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14837 do iter = 1, xrows
14838# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14839 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14840# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14841 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14842# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14843 end do
14844# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14845 close (unit)
14846# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14847 end do
14848# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14849
14850# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14851 ! Calculate offsets
14852# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14853 domain_xstart = x_coords(1)
14854# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14855 x_step = x_cc(1) - x_cc(0)
14856# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14857 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
14858# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14859 global_offset_x = nint(abs(delta_x)/x_step)
14860# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14861 case (3) ! 3D case - determine grid structure
14862# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14863 ! Find yRows by counting rows with same x
14864# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14865 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14866# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14867 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14868# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14869
14870# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14871 yrows = 1
14872# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14873 do
14874# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14875 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14876# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14877 if (ios2 /= 0) exit
14878# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14879 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
14880# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14881 yrows = yrows + 1
14882# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14883 else
14884# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14885 exit
14886# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14887 end if
14888# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14889 end do
14890# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14891 close (unit2)
14892# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14893
14894# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14895 ! Count total rows
14896# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14897 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14898# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14899 nrows = 0
14900# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14901 do
14902# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14903 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14904# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14905 if (ios2 /= 0) exit
14906# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14907 nrows = nrows + 1
14908# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14909 end do
14910# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14911 close (unit2)
14912# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14913
14914# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14915 xrows = nrows/yrows
14916# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14917#ifdef MFC_DEBUG
14918# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14919 block
14920# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14921 use iso_fortran_env, only: output_unit
14922# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14923
14924# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14925 print *, 'm_icpp_patches.fpp:1181: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14926# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14927
14928# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14929 call flush (output_unit)
14930# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14931 end block
14932# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14933#endif
14934# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14935 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14936# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14937
14938# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14939
14940# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14941
14942# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14943
14944# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14945#if defined(MFC_OpenACC)
14946# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14947!$acc enter data create(x_coords, y_coords, stored_values)
14948# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14949#elif defined(MFC_OpenMP)
14950# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14951!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14952# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14953#endif
14954# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14955 index_x = i
14956# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14957 index_y = j
14958# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14959
14960# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14961 ! Read all files
14962# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14963 do f = 1, max_files
14964# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14965 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14966# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14967 if (ios /= 0) then
14968# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14969 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14970# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14971 cycle
14972# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14973 end if
14974# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14975
14976# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14977 iter = 0
14978# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14979 do iix = 1, xrows
14980# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14981 do iiy = 1, yrows
14982# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14983 iter = iter + 1
14984# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14985 if (f == 1) then
14986# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14987 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14988# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14989 else
14990# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14991 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14992# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14993 end if
14994# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14995 if (ios /= 0) call s_mpi_abort("Error reading data")
14996# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14997 end do
14998# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14999 end do
15000# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15001 close (unit)
15002# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15003 end do
15004# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15005
15006# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15007 ! Calculate offsets
15008# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15009 x_step = x_cc(1) - x_cc(0)
15010# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15011 y_step = y_cc(1) - y_cc(0)
15012# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15013 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15014# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15015 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15016# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15017 global_offset_x = nint(abs(delta_x)/x_step)
15018# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15019 global_offset_y = nint(abs(delta_y)/y_step)
15020# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15021 end select
15022# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15023
15024# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15025 files_loaded = .true.
15026# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15027 end if
15028# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15029
15030# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15031 ! Data assignment
15032# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15033 select case (num_dims)
15034# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15035 case (1)
15036# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15037 idx = i + 1 + global_offset_x
15038# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15039 do f = 1, sys_size
15040# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15041 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15042# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15043 end do
15044# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15045 case (2)
15046# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15047 idx = i + 1 + global_offset_x - index_x
15048# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15049 do f = 1, sys_size - 1
15050# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15051 jump = merge(1, 0, f >= eqn_idx%mom%end)
15052# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15053 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15054# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15055 end do
15056# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15057 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15058# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15059 case (3)
15060# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15061 idx = i + 1 + global_offset_x - index_x
15062# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15063 idy = j + 1 + global_offset_y - index_y
15064# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15065 do f = 1, sys_size - 1
15066# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15067 jump = merge(1, 0, f >= eqn_idx%mom%end)
15068# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15069 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15070# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15071 end do
15072# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15073 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15074# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15075 end select
15076# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15077 case (380) ! Taylor-Green vortex
15078# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15079 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15080# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15081 ! geometry 9
15082# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15083 mach = 0.1
15084# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15085 if (patch_id == 1) then
15086# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15087 q_prim_vf(eqn_idx%E)%sf(i, j, &
15088# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15089 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
15090# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15091 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
15092# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15093 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
15094# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15095 end if
15096# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15097 case default
15098# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15099 call s_int_to_str(patch_id, istr)
15100# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15101 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
15102# 1181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15103 end select
15104 end if
15105
15106 ! Updating the patch identities bookkeeping variable
15107 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15108 end if
15109 end do
15110 end do
15111 end do
15112 if (allocated(stored_values)) then
15113# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15114#ifdef MFC_DEBUG
15115# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15116 block
15117# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15118 use iso_fortran_env, only: output_unit
15119# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15120
15121# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15122 print *, 'm_icpp_patches.fpp:1190: ', '@:DEALLOCATE(stored_values)'
15123# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15124
15125# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15126 call flush (output_unit)
15127# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15128 end block
15129# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15130#endif
15131# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15132
15133# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15134#if defined(MFC_OpenACC)
15135# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15136!$acc exit data delete(stored_values)
15137# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15138#elif defined(MFC_OpenMP)
15139# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15140!$omp target exit data map(release:stored_values)
15141# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15142#endif
15143# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15144 deallocate (stored_values)
15145# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15146#ifdef MFC_DEBUG
15147# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15148 block
15149# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15150 use iso_fortran_env, only: output_unit
15151# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15152
15153# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15154 print *, 'm_icpp_patches.fpp:1190: ', '@:DEALLOCATE(x_coords)'
15155# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15156
15157# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15158 call flush (output_unit)
15159# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15160 end block
15161# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15162#endif
15163# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15164
15165# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15166#if defined(MFC_OpenACC)
15167# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15168!$acc exit data delete(x_coords)
15169# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15170#elif defined(MFC_OpenMP)
15171# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15172!$omp target exit data map(release:x_coords)
15173# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15174#endif
15175# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15176 deallocate (x_coords)
15177# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15178 end if
15179# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15180
15181# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15182 if (allocated(y_coords)) then
15183# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15184#ifdef MFC_DEBUG
15185# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15186 block
15187# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15188 use iso_fortran_env, only: output_unit
15189# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15190
15191# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15192 print *, 'm_icpp_patches.fpp:1190: ', '@:DEALLOCATE(y_coords)'
15193# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15194
15195# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15196 call flush (output_unit)
15197# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15198 end block
15199# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15200#endif
15201# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15202
15203# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15204#if defined(MFC_OpenACC)
15205# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15206!$acc exit data delete(y_coords)
15207# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15208#elif defined(MFC_OpenMP)
15209# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15210!$omp target exit data map(release:y_coords)
15211# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15212#endif
15213# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15214 deallocate (y_coords)
15215# 1190 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15216 end if
15217
15218 end subroutine s_icpp_cylinder
15219
15220 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
15221 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
15222 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
15223 !! the smoothing of its boundary.
15224 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
15225
15226 integer, intent(in) :: patch_id
15227
15228#ifdef MFC_MIXED_PRECISION
15229 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15230#else
15231 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15232#endif
15233 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15234 integer :: i, j, k !< Generic loop iterators
15235 real(wp) :: a, b, c, d
15236
15237 integer :: xRows, yRows, nRows, iix, iiy, max_files
15238# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15239 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
15240# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15241 real(wp) :: x_len, x_step, y_len, y_step
15242# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15243 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15244# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15245 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
15246# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15247 real(wp) :: delta_x, delta_y
15248# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15249 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
15250# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15251 character(len=200) :: errmsg
15252# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15253 real(wp), allocatable :: stored_values(:,:,:)
15254# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15255 real(wp), allocatable :: x_coords(:), y_coords(:)
15256# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15257 logical :: files_loaded = .false.
15258# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15259 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
15260# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15261 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
15262# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15263 character(len=20) :: file_num_str !< For storing the file number as a string
15264# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15265 character(len=20) :: zeros_part !< For the trailing zeros part
15266# 1211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15267 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
15268 ! Place any declaration of intermediate variables here
15269# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15270 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15271# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15272 real(wp) :: eps
15273# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15274
15275# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15276 ! IGR Jets Arrays to stor position and radii of jets from input file
15277# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15278 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15279# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15280 ! Variables to describe initial condition of jet
15281# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15282 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15283# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15284 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
15285# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15286 real(wp), dimension(0:n,0:p) :: rcut_arr
15287# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15288 integer :: l, q, s !< Iterators for reading input files
15289# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15290 integer :: start, end !< Ints to keep track of position in file
15291# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15292 character(len=1000) :: line !< String to store line in file
15293# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15294 character(len=25) :: value !< String to store value in line
15295# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15296 integer :: NJet !< Number of jets
15297# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15298
15299# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15300 eps = 1e-9_wp
15301# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15302
15303# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15304 if (patch_icpp(patch_id)%hcid == 303) then
15305# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15306 eps_smooth = 3._wp
15307# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15308 open (unit=10, file="njet.txt", status="old", action="read")
15309# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15310 read (10, *) njet
15311# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15312 close (10)
15313# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15314
15315# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15316 allocate (y_th_arr(0:njet - 1))
15317# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15318 allocate (z_th_arr(0:njet - 1))
15319# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15320 allocate (r_th_arr(0:njet - 1))
15321# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15322
15323# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15324 open (unit=10, file="jets.csv", status="old", action="read")
15325# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15326 do q = 0, njet - 1
15327# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15328 read (10, '(A)') line ! Read a full line as a string
15329# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15330 start = 1
15331# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15332
15333# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15334 do l = 0, 2
15335# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15336 end = index(line(start:), ',') ! Find the next comma
15337# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15338 if (end == 0) then
15339# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15340 value = trim(adjustl(line(start:))) ! Last value in the line
15341# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15342 else
15343# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15344 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15345# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15346 start = start + end ! Move to next value
15347# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15348 end if
15349# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15350 if (l == 0) then
15351# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15352 read (value, *) y_th_arr(q) ! Convert string to numeric value
15353# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15354 else if (l == 1) then
15355# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15356 read (value, *) z_th_arr(q)
15357# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15358 else
15359# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15360 read (value, *) r_th_arr(q)
15361# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15362 end if
15363# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15364 end do
15365# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15366 end do
15367# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15368 close (10)
15369# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15370
15371# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15372 do q = 0, p
15373# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15374 do l = 0, n
15375# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15376 rcut = 0._wp
15377# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15378 do s = 0, njet - 1
15379# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15380 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15381# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15382 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15383# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15384 end do
15385# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15386 rcut_arr(l, q) = rcut
15387# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15388 end do
15389# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15390 end do
15391# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15392 end if
15393
15394 ! Transferring the centroid information of the plane to be swept
15395 x_centroid = patch_icpp(patch_id)%x_centroid
15396 y_centroid = patch_icpp(patch_id)%y_centroid
15397 z_centroid = patch_icpp(patch_id)%z_centroid
15398 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15399 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15400
15401 ! Obtaining coefficients of the equation describing the sweep plane
15402 a = patch_icpp(patch_id)%normal(1)
15403 b = patch_icpp(patch_id)%normal(2)
15404 c = patch_icpp(patch_id)%normal(3)
15405 d = -a*x_centroid - b*y_centroid - c*z_centroid
15406
15407 ! Initialize eta=1; modified if smoothing is enabled
15408 eta = 1._wp
15409
15410 ! Assign patch vars if cell is covered and patch has write permission
15411 do k = 0, p
15412 do j = 0, n
15413 do i = 0, m
15414 if (grid_geometry == 3) then
15415 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
15416 else
15417 cart_y = y_cc(j)
15418 cart_z = z_cc(k)
15419 end if
15420
15421 if (patch_icpp(patch_id)%smoothen) then
15422 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, &
15423 & dz)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
15424 end if
15425
15426 if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
15427 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
15428 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
15429
15430
15431 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15432 select case (patch_icpp(patch_id)%hcid)
15433# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15434 case (300) ! Rayleigh-Taylor instability
15435# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15436 rhoh = 3._wp
15437# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15438 rhol = 1._wp
15439# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15440 pref = 1.e5_wp
15441# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15442 pint = pref
15443# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15444 h = 0.7_wp
15445# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15446 lam = 0.2_wp
15447# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15448 wl = 2._wp*pi/lam
15449# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15450 amp = 0.025_wp/wl
15451# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15452
15453# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15454 inth = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h
15455# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15456
15457# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15458 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15459# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15460
15461# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15462 if (alph < eps) alph = eps
15463# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15464 if (alph > 1._wp - eps) alph = 1._wp - eps
15465# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15466
15467# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15468 if (y_cc(j) > inth) then
15469# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15470 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15471# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15472 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15473# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15474 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15475# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15476 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15477# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15478 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15479# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15480 else
15481# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15482 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15483# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15484 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15485# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15486 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15487# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15488 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15489# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15490 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15491# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15492 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15493# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15494 end if
15495# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15496 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15497# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15498 h = 0.0_wp
15499# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15500 lam = 1.0_wp
15501# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15502 amp = patch_icpp(patch_id)%a(2)
15503# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15504 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15505# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15506 if (x_cc(i) > inth) then
15507# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15508 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15509# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15510 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15511# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15512 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
15513# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15514 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15515# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15516 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15517# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15518 end if
15519# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15520 case (302) ! 3D Jet with IGR
15521# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15522 ux_th = 10*sqrt(1.4*0.4)
15523# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15524 ux_am = 0.0*sqrt(1.4)
15525# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15526 p_th = 2.0_wp
15527# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15528 p_am = 1.0_wp
15529# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15530 rho_th = 1._wp
15531# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15532 rho_am = 1._wp
15533# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15534 y_th = 0.0_wp
15535# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15536 z_th = 0.0_wp
15537# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15538 r_th = 1._wp
15539# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15540 eps_smooth = 1._wp
15541# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15542 eps = 1e-6
15543# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15544
15545# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15546 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15547# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15548 rcut = f_cut_on(r - r_th, eps_smooth)
15549# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15550 xcut = f_cut_on(x_cc(i), eps_smooth)
15551# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15552
15553# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15554 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15555# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15556 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15557# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15558 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15559# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15560
15561# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15562 if (num_fluids == 1) then
15563# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15564 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15565# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15566 else
15567# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15568 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15569# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15570 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15571# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15572 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
15573# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15574 end if
15575# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15576
15577# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15578 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15579# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15580 case (303) ! 3D Multijet
15581# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15582 eps_smooth = 3.0_wp
15583# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15584 ux_th = 10*sqrt(1.4*0.4)
15585# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15586 ux_am = 2.5*sqrt(1.4*0.4)
15587# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15588 p_th = 0.8_wp
15589# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15590 p_am = 0.4_wp
15591# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15592 rho_th = 1._wp
15593# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15594 rho_am = 1._wp
15595# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15596 eps = 1e-6
15597# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15598
15599# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15600 rcut = rcut_arr(j, k)
15601# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15602 xcut = f_cut_on(x_cc(i), eps_smooth)
15603# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15604
15605# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15606 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15607# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15608 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15609# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15610 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15611# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15612
15613# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15614 if (num_fluids == 1) then
15615# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15616 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15617# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15618 else
15619# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15620 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15621# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15622 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15623# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15624 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
15625# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15626 end if
15627# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15628
15629# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15630 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15631# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15632 case (370) ! 3D extrusion of 2D profile from external data
15633# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15634 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15635# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15636 if (.not. files_loaded) then
15637# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15638 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15639# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15640 do f = 1, max_files
15641# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15642 write (file_num_str, '(I0)') f
15643# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15644 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
15645# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15646 end do
15647# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15648
15649# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15650 ! Common file reading setup
15651# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15652 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15653# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15654 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
15655# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15656
15657# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15658 select case (num_dims)
15659# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15660 case (1, 2) ! 1D and 2D cases are similar
15661# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15662 ! Count lines
15663# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15664 line_count = 0
15665# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15666 do
15667# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15668 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15669# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15670 if (ios2 /= 0) exit
15671# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15672 line_count = line_count + 1
15673# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15674 end do
15675# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15676 close (unit2)
15677# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15678
15679# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15680 xrows = line_count
15681# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15682 yrows = 1
15683# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15684 index_x = 0
15685# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15686 if (num_dims == 2) index_x = i
15687# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15688#ifdef MFC_DEBUG
15689# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15690 block
15691# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15692 use iso_fortran_env, only: output_unit
15693# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15694
15695# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15696 print *, 'm_icpp_patches.fpp:1252: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15697# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15698
15699# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15700 call flush (output_unit)
15701# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15702 end block
15703# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15704#endif
15705# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15706 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15707# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15708
15709# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15710
15711# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15712
15713# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15714#if defined(MFC_OpenACC)
15715# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15716!$acc enter data create(x_coords, stored_values)
15717# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15718#elif defined(MFC_OpenMP)
15719# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15720!$omp target enter data map(always,alloc:x_coords, stored_values)
15721# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15722#endif
15723# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15724
15725# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15726 ! Read data from all files
15727# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15728 do f = 1, max_files
15729# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15730 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15731# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15732 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15733# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15734
15735# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15736 do iter = 1, xrows
15737# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15738 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15739# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15740 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
15741# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15742 end do
15743# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15744 close (unit)
15745# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15746 end do
15747# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15748
15749# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15750 ! Calculate offsets
15751# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15752 domain_xstart = x_coords(1)
15753# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15754 x_step = x_cc(1) - x_cc(0)
15755# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15756 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
15757# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15758 global_offset_x = nint(abs(delta_x)/x_step)
15759# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15760 case (3) ! 3D case - determine grid structure
15761# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15762 ! Find yRows by counting rows with same x
15763# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15764 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15765# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15766 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15767# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15768
15769# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15770 yrows = 1
15771# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15772 do
15773# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15774 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15775# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15776 if (ios2 /= 0) exit
15777# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15778 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
15779# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15780 yrows = yrows + 1
15781# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15782 else
15783# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15784 exit
15785# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15786 end if
15787# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15788 end do
15789# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15790 close (unit2)
15791# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15792
15793# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15794 ! Count total rows
15795# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15796 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15797# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15798 nrows = 0
15799# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15800 do
15801# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15802 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15803# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15804 if (ios2 /= 0) exit
15805# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15806 nrows = nrows + 1
15807# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15808 end do
15809# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15810 close (unit2)
15811# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15812
15813# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15814 xrows = nrows/yrows
15815# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15816#ifdef MFC_DEBUG
15817# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15818 block
15819# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15820 use iso_fortran_env, only: output_unit
15821# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15822
15823# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15824 print *, 'm_icpp_patches.fpp:1252: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
15825# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15826
15827# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15828 call flush (output_unit)
15829# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15830 end block
15831# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15832#endif
15833# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15834 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
15835# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15836
15837# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15838
15839# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15840
15841# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15842
15843# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15844#if defined(MFC_OpenACC)
15845# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15846!$acc enter data create(x_coords, y_coords, stored_values)
15847# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15848#elif defined(MFC_OpenMP)
15849# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15850!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
15851# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15852#endif
15853# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15854 index_x = i
15855# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15856 index_y = j
15857# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15858
15859# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15860 ! Read all files
15861# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15862 do f = 1, max_files
15863# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15864 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15865# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15866 if (ios /= 0) then
15867# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15868 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15869# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15870 cycle
15871# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15872 end if
15873# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15874
15875# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15876 iter = 0
15877# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15878 do iix = 1, xrows
15879# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15880 do iiy = 1, yrows
15881# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15882 iter = iter + 1
15883# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15884 if (f == 1) then
15885# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15886 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15887# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15888 else
15889# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15890 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15891# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15892 end if
15893# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15894 if (ios /= 0) call s_mpi_abort("Error reading data")
15895# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15896 end do
15897# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15898 end do
15899# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15900 close (unit)
15901# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15902 end do
15903# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15904
15905# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15906 ! Calculate offsets
15907# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15908 x_step = x_cc(1) - x_cc(0)
15909# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15910 y_step = y_cc(1) - y_cc(0)
15911# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15912 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15913# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15914 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15915# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15916 global_offset_x = nint(abs(delta_x)/x_step)
15917# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15918 global_offset_y = nint(abs(delta_y)/y_step)
15919# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15920 end select
15921# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15922
15923# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15924 files_loaded = .true.
15925# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15926 end if
15927# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15928
15929# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15930 ! Data assignment
15931# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15932 select case (num_dims)
15933# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15934 case (1)
15935# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15936 idx = i + 1 + global_offset_x
15937# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15938 do f = 1, sys_size
15939# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15940 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15941# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15942 end do
15943# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15944 case (2)
15945# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15946 idx = i + 1 + global_offset_x - index_x
15947# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15948 do f = 1, sys_size - 1
15949# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15950 jump = merge(1, 0, f >= eqn_idx%mom%end)
15951# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15952 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15953# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15954 end do
15955# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15956 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15957# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15958 case (3)
15959# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15960 idx = i + 1 + global_offset_x - index_x
15961# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15962 idy = j + 1 + global_offset_y - index_y
15963# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15964 do f = 1, sys_size - 1
15965# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15966 jump = merge(1, 0, f >= eqn_idx%mom%end)
15967# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15968 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15969# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15970 end do
15971# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15972 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15973# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15974 end select
15975# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15976 case (380) ! Taylor-Green vortex
15977# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15978 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15979# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15980 ! geometry 9
15981# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15982 mach = 0.1
15983# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15984 if (patch_id == 1) then
15985# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15986 q_prim_vf(eqn_idx%E)%sf(i, j, &
15987# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15988 & k) = 101325 + (mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2)
15989# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15990 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
15991# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15992 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
15993# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15994 end if
15995# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15996 case default
15997# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15998 call s_int_to_str(patch_id, istr)
15999# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16000 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
16001# 1252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16002 end select
16003 end if
16004
16005 ! Updating the patch identities bookkeeping variable
16006 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
16007 end if
16008 end do
16009 end do
16010 end do
16011 if (allocated(stored_values)) then
16012# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16013#ifdef MFC_DEBUG
16014# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16015 block
16016# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16017 use iso_fortran_env, only: output_unit
16018# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16019
16020# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16021 print *, 'm_icpp_patches.fpp:1261: ', '@:DEALLOCATE(stored_values)'
16022# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16023
16024# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16025 call flush (output_unit)
16026# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16027 end block
16028# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16029#endif
16030# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16031
16032# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16033#if defined(MFC_OpenACC)
16034# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16035!$acc exit data delete(stored_values)
16036# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16037#elif defined(MFC_OpenMP)
16038# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16039!$omp target exit data map(release:stored_values)
16040# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16041#endif
16042# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16043 deallocate (stored_values)
16044# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16045#ifdef MFC_DEBUG
16046# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16047 block
16048# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16049 use iso_fortran_env, only: output_unit
16050# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16051
16052# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16053 print *, 'm_icpp_patches.fpp:1261: ', '@:DEALLOCATE(x_coords)'
16054# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16055
16056# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16057 call flush (output_unit)
16058# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16059 end block
16060# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16061#endif
16062# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16063
16064# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16065#if defined(MFC_OpenACC)
16066# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16067!$acc exit data delete(x_coords)
16068# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16069#elif defined(MFC_OpenMP)
16070# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16071!$omp target exit data map(release:x_coords)
16072# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16073#endif
16074# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16075 deallocate (x_coords)
16076# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16077 end if
16078# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16079
16080# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16081 if (allocated(y_coords)) then
16082# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16083#ifdef MFC_DEBUG
16084# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16085 block
16086# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16087 use iso_fortran_env, only: output_unit
16088# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16089
16090# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16091 print *, 'm_icpp_patches.fpp:1261: ', '@:DEALLOCATE(y_coords)'
16092# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16093
16094# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16095 call flush (output_unit)
16096# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16097 end block
16098# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16099#endif
16100# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16101
16102# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16103#if defined(MFC_OpenACC)
16104# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16105!$acc exit data delete(y_coords)
16106# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16107#elif defined(MFC_OpenMP)
16108# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16109!$omp target exit data map(release:y_coords)
16110# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16111#endif
16112# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16113 deallocate (y_coords)
16114# 1261 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16115 end if
16116
16117 end subroutine s_icpp_sweep_plane
16118
16119 !> The STL patch is a 2/3D geometry that is imported from an STL file.
16120 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
16121
16122 integer, intent(in) :: patch_id
16123
16124#ifdef MFC_MIXED_PRECISION
16125 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16126#else
16127 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16128#endif
16129 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16130 integer :: i, j, k !< loop iterators
16131 integer :: model_id !< Index into the preloading stl_models(:)
16132 real(wp) :: threshold !< Inside/outside cutoff for this model
16133 real(wp), dimension(1:3) :: point !< Cell-center query point
16134 logical :: in_box !< Whether the cell center lies in the model's bounding box
16135
16136 model_id = patch_icpp(patch_id)%model_id
16137 threshold = stl_models(model_id)%model_threshold
16138
16139 do i = 0, m; do j = 0, n; do k = 0, p
16140 point = (/x_cc(i), y_cc(j), 0._wp/)
16141 if (p > 0) point(3) = z_cc(k)
16142 if (grid_geometry == 3) point = f_convert_cyl_to_cart(point)
16143
16144 ! Run the winding test only on cells whose Cartesian point lies inside the bounding box, else skip the calculation
16145 in_box = point(1) >= stl_bounding_boxes(model_id, 1, 1) .and. point(1) <= stl_bounding_boxes(model_id, 1, &
16146 & 3) .and. point(2) >= stl_bounding_boxes(model_id, 2, &
16147 & 1) .and. point(2) <= stl_bounding_boxes(model_id, 2, 3)
16148 if (p > 0 .or. grid_geometry == 3) then
16149 in_box = in_box .and. point(3) >= stl_bounding_boxes(model_id, 3, &
16150 & 1) .and. point(3) <= stl_bounding_boxes(model_id, 3, 3)
16151 end if
16152
16153 if (in_box) then
16154 eta = f_model_is_inside(gpu_ntrs(model_id), model_id, point)
16155 else
16156 eta = 0._wp
16157 end if
16158
16159 if (eta > threshold) then
16160 eta = 1._wp
16161 else if (.not. patch_icpp(patch_id)%smoothen) then
16162 eta = 0._wp
16163 end if
16164
16165 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
16166
16167
16168 end do; end do; end do
16169
16170 end subroutine s_icpp_model
16171
16172 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
16173 subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
16174
16175
16176# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16177#if MFC_OpenACC
16178# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16179!$acc routine seq
16180# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16181#elif MFC_OpenMP
16182# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16183
16184# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16185
16186# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16187!$omp declare target device_type(any)
16188# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16189#endif
16190
16191 real(wp), intent(in) :: cyl_y, cyl_z
16192
16193 cart_y = cyl_y*sin(cyl_z)
16194 cart_z = cyl_y*cos(cyl_z)
16195
16196 end subroutine s_convert_cylindrical_to_cartesian_coord
16197
16198 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
16199 function f_convert_cyl_to_cart(cyl) result(cart)
16200
16201
16202# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16203#if MFC_OpenACC
16204# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16205!$acc routine seq
16206# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16207#elif MFC_OpenMP
16208# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16209
16210# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16211
16212# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16213!$omp declare target device_type(any)
16214# 1333 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16215#endif
16216
16217 real(wp), dimension(1:3), intent(in) :: cyl
16218 real(wp), dimension(1:3) :: cart
16219
16220 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
16221
16222 end function f_convert_cyl_to_cart
16223
16224 !> Archimedes spiral function
16225 elemental function f_r(myth, offset, a)
16226
16227
16228# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16229#if MFC_OpenACC
16230# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16231!$acc routine seq
16232# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16233#elif MFC_OpenMP
16234# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16235
16236# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16237
16238# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16239!$omp declare target device_type(any)
16240# 1345 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16241#endif
16242 real(wp), intent(in) :: myth, offset, a
16243 real(wp) :: b
16244 real(wp) :: f_r
16245
16246 ! r(th) = a + b*th
16247
16248 b = 2._wp*a/(2._wp*pi)
16249 f_r = a + b*myth + offset
16250
16251 end function f_r
16252
16253end module m_icpp_patches
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1068
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1068
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1068
m_assign_variables
Assigns initial primitive variables to computational cells based on patch geometry.
Definition m_assign_variables.fpp.f90:328
m_assign_variables::s_assign_patch_primitive_variables
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Pointer to mixture or species patch assignment routine.
Definition m_assign_variables.fpp.f90:344
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_4eq
integer, parameter model_eqns_4eq
Definition m_constants.fpp.f90:136
m_constants::small_radius
real(wp), parameter small_radius
Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:19
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:23
m_constants::max_2d_fourier_modes
integer, parameter max_2d_fourier_modes
Max Fourier mode index for 2D modal patch (geometry 13).
Definition m_constants.fpp.f90:37
m_constants::max_sph_harm_degree
integer, parameter max_sph_harm_degree
Max degree L for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:38
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
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
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor Number of cells in the x-, y- and z-coordinate directions.
Definition m_global_parameters.fpp.f90:39
m_global_parameters::x_cc
real(wp), dimension(:), allocatable x_cc
Locations of cell-centers (cc) in x-, y- and z-directions, respectively.
Definition m_global_parameters.fpp.f90:47
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:334
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:328
m_icpp_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_icpp_patches.fpp.f90:387
m_icpp_patches::s_icpp_ellipse
subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid an...
Definition m_icpp_patches.fpp.f90:6009
m_icpp_patches::cart_y
real(wp) cart_y
Definition m_icpp_patches.fpp.f90:409
m_icpp_patches::y_centroid
real(wp) y_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::length_x
real(wp) length_x
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::x_centroid
real(wp) x_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::f_convert_cyl_to_cart
real(wp) function, dimension(1:3) f_convert_cyl_to_cart(cyl)
Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
Definition m_icpp_patches.fpp.f90:16200
m_icpp_patches::s_icpp_circle
subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet....
Definition m_icpp_patches.fpp.f90:2514
m_icpp_patches::s_icpp_2d_taylorgreen_vortex
subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of...
Definition m_icpp_patches.fpp.f90:10414
m_icpp_patches::s_icpp_cuboid
subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:13405
m_icpp_patches::s_icpp_varcircle
subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
The varcircle patch is a 2D geometry that may be used . It generatres an annulus.
Definition m_icpp_patches.fpp.f90:3814
m_icpp_patches::s_icpp_2d_modal
subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form...
Definition m_icpp_patches.fpp.f90:12389
m_icpp_patches::cart_z
real(wp) cart_z
Definition m_icpp_patches.fpp.f90:409
m_icpp_patches::length_z
real(wp) length_z
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::istr
character(len=5) istr
string to store int to string result for error checking
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::s_icpp_sweep_plane
subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:15225
m_icpp_patches::s_icpp_rectangle
subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:8213
m_icpp_patches::s_apply_icpp_patches
impure subroutine, public s_apply_icpp_patches(patch_id_fp, q_prim_vf)
Dispatch each initial condition patch to its geometry-specific initialization routine.
Definition m_icpp_patches.fpp.f90:417
m_icpp_patches::smooth_coeff
real(wp) smooth_coeff
Smoothing coefficient (mirrors ic_patch_parameterssmooth_coeff).
Definition m_icpp_patches.fpp.f90:407
m_icpp_patches::s_icpp_line_segment
subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem....
Definition m_icpp_patches.fpp.f90:539
m_icpp_patches::y_boundary
type(bounds_info) y_boundary
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::s_icpp_sphere
subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet...
Definition m_icpp_patches.fpp.f90:12508
m_icpp_patches::eta
real(wp) eta
Pseudo volume fraction for patch boundary smoothing.
Definition m_icpp_patches.fpp.f90:408
m_icpp_patches::s_icpp_1d_bubble_pulse
subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
Definition m_icpp_patches.fpp.f90:11728
m_icpp_patches::s_icpp_3d_spherical_harmonic
subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,...
Definition m_icpp_patches.fpp.f90:12444
m_icpp_patches::length_y
real(wp) length_y
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::s_icpp_model
subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
The STL patch is a 2/3D geometry that is imported from an STL file.
Definition m_icpp_patches.fpp.f90:16121
m_icpp_patches::s_convert_cylindrical_to_cartesian_coord
subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
Definition m_icpp_patches.fpp.f90:16174
m_icpp_patches::f_r
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
Definition m_icpp_patches.fpp.f90:16226
m_icpp_patches::z_centroid
real(wp) z_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::x_boundary
type(bounds_info) x_boundary
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::smooth_patch_id
integer smooth_patch_id
Definition m_icpp_patches.fpp.f90:406
m_icpp_patches::z_boundary
type(bounds_info) z_boundary
Patch boundary locations in x, y, z.
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::s_icpp_sweep_line
subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:9529
m_icpp_patches::s_icpp_ellipsoid
subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid a...
Definition m_icpp_patches.fpp.f90:7312
m_icpp_patches::s_icpp_cylinder
subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical sol...
Definition m_icpp_patches.fpp.f90:14303
m_icpp_patches::s_icpp_spiral
impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when it...
Definition m_icpp_patches.fpp.f90:1203
m_icpp_patches::s_icpp_3dvarcircle
subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
Definition m_icpp_patches.fpp.f90:5117
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:318
m_model::s_instantiate_stl_models
subroutine, public s_instantiate_stl_models()
Load, transform, and register STL/OBJ immersed-boundary models onto the simulation grid.
Definition m_model.fpp.f90:1258
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:328
m_mpi_common::s_mpi_abort
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
Definition m_mpi_common.fpp.f90:872
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::gammas
real(wp), dimension(:), allocatable, public gammas
Definition m_variables_conversion.fpp.f90:363
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:363
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:363
m_derived_types::bounds_info
Derived type adding beginning (beg) and end bounds info as attributes.
Definition m_derived_types.fpp.f90:532
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331