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# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 14 "/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 momxe
45!> - Sets momxe 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# 59 "/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# 18 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 314 "/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
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_x, cart_y, cart_z
410 real(wp) :: sph_phi !< Spherical phi for Cartesian conversion in cylindrical coordinates
411 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
412 character(len=5) :: istr !< string to store int to string result for error checking
413
414contains
415
416 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
417 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
418
419 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
420
421#ifdef MFC_MIXED_PRECISION
422 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
423#else
424 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
425#endif
426 integer :: i
427
428 ! 3D Patch Geometries
429
430 if (p > 0) then
431 do i = 1, num_patches
432 if (proc_rank == 0) then
433 print *, 'Processing patch', i
434 end if
435
436 !> ICPP Patches
437 !> @{
438 ! Spherical patch
439 if (patch_icpp(i)%geometry == 8) then
440 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
441 ! Cuboidal patch
442 else if (patch_icpp(i)%geometry == 9) then
443 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
444 ! Cylindrical patch
445 else if (patch_icpp(i)%geometry == 10) then
446 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
447 ! Swept plane patch
448 else if (patch_icpp(i)%geometry == 11) then
449 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
450 ! Ellipsoidal patch
451 else if (patch_icpp(i)%geometry == 12) then
452 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
453 ! 3D spherical harmonic patch
454 else if (patch_icpp(i)%geometry == 14) then
455 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
456 ! 3D Modified circular patch
457 else if (patch_icpp(i)%geometry == 19) then
458 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
459 ! 3D STL patch
460 else if (patch_icpp(i)%geometry == 21) then
461 call s_icpp_model(i, patch_id_fp, q_prim_vf)
462 end if
463 end do
464 !> @}
465
466 ! 2D Patch Geometries
467 else if (n > 0) then
468 do i = 1, num_patches
469 if (proc_rank == 0) then
470 print *, 'Processing patch', i
471 end if
472
473 !> ICPP Patches
474 !> @{
475 ! Circular patch
476 if (patch_icpp(i)%geometry == 2) then
477 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
478 ! Rectangular patch
479 else if (patch_icpp(i)%geometry == 3) then
480 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
481 ! Swept line patch
482 else if (patch_icpp(i)%geometry == 4) then
483 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
484 ! Elliptical patch
485 else if (patch_icpp(i)%geometry == 5) then
486 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
487 ! Unimplemented patch (formerly isentropic vortex)
488 else if (patch_icpp(i)%geometry == 6) then
489 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
490 & // 'which no longer exists. See Examples. Exiting.')
491 ! 2D modal (Fourier) patch
492 else if (patch_icpp(i)%geometry == 13) then
493 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
494 ! Spiral patch
495 else if (patch_icpp(i)%geometry == 17) then
496 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
497 ! Modified circular patch
498 else if (patch_icpp(i)%geometry == 18) then
499 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
500 ! TaylorGreen vortex patch
501 else if (patch_icpp(i)%geometry == 20) then
502 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
503 ! STL patch
504 else if (patch_icpp(i)%geometry == 21) then
505 call s_icpp_model(i, patch_id_fp, q_prim_vf)
506 end if
507 !> @}
508 end do
509
510 ! 1D Patch Geometries
511 else
512 do i = 1, num_patches
513 if (proc_rank == 0) then
514 print *, 'Processing patch', i
515 end if
516
517 ! Line segment patch
518 if (patch_icpp(i)%geometry == 1) then
519 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
520 ! 1d analytical
521 else if (patch_icpp(i)%geometry == 16) then
522 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
523 end if
524 end do
525 end if
526
527 end subroutine s_apply_icpp_patches
528
529 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
530 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
531 !! patch DOES NOT allow for the smearing of its boundaries.
532 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
533
534 integer, intent(in) :: patch_id
535
536#ifdef MFC_MIXED_PRECISION
537 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
538#else
539 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
540#endif
541 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
542
543 ! Generic loop iterators
544 integer :: i, j, k
545
546 ! Placeholders for the cell boundary values
547 real(wp) :: pi_inf, gamma, lit_gamma
548
549 integer :: xRows, yRows, nRows, iix, iiy, max_files
550# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
551 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
552# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
553 real(wp) :: x_len, x_step, y_len, y_step
554# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
555 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
556# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
557 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
558# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
559 real(wp) :: delta_x, delta_y
560# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
561 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
562# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
563 character(len=200) :: errmsg
564# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
565 real(wp), allocatable :: stored_values(:,:,:)
566# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
567 real(wp), allocatable :: x_coords(:), y_coords(:)
568# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
569 logical :: files_loaded = .false.
570# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
571 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
572# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
573 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
574# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
575 character(len=20) :: file_num_str !< For storing the file number as a string
576# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
577 character(len=20) :: zeros_part !< For the trailing zeros part
578# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
579 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
580 ! Place any declaration of intermediate variables here
581# 176 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
582 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
583
584 pi_inf = pi_infs(1)
585 gamma = gammas(1)
586 lit_gamma = gs_min(1)
587 j = 0
588 k = 0
589
590 ! Transferring the line segment's centroid and length information
591 x_centroid = patch_icpp(patch_id)%x_centroid
592 length_x = patch_icpp(patch_id)%length_x
593
594 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
595 x_boundary%beg = x_centroid - 0.5_wp*length_x
596 x_boundary%end = x_centroid + 0.5_wp*length_x
597
598 ! Set eta=1 (no smoothing for this patch type)
599 eta = 1._wp
600
601 ! Assign patch vars if cell is covered and patch has write permission
602 do i = 0, m
603 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, &
604 & 0, 0))) then
605 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
606
607
608
609 ! check if this should load a hardcoded patch
610 if (patch_icpp(patch_id)%hcid /= dflt_int) then
611 select case (patch_icpp(patch_id)%hcid)
612# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
613 case (150) ! 1D Smooth Alfven Case for MHD
614# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
615 ! velocity
616# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
617 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
618# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
619 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
620# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
621
622# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
623 ! magnetic field
624# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
625 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
626# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
627 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
628# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
629 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
630# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
631 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
632# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
633 ! SDtoolbox)
634# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
635 if (.not. files_loaded) then
636# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
637 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
638# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
639 do f = 1, max_files
640# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
641 write (file_num_str, '(I0)') f
642# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
643 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
644# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
645 end do
646# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
647
648# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
649 ! Common file reading setup
650# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
651 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
652# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
653 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
654# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
655
656# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
657 select case (num_dims)
658# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
659 case (1, 2) ! 1D and 2D cases are similar
660# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
661 ! Count lines
662# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
663 line_count = 0
664# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
665 do
666# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
667 read (unit2, *, iostat=ios2) dummy_x, dummy_y
668# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
669 if (ios2 /= 0) exit
670# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
671 line_count = line_count + 1
672# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
673 end do
674# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
675 close (unit2)
676# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
677
678# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
679 xrows = line_count
680# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
681 yrows = 1
682# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
683 index_x = 0
684# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
685 if (num_dims == 2) index_x = i
686# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
687#ifdef MFC_DEBUG
688# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
689 block
690# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
691 use iso_fortran_env, only: output_unit
692# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
693
694# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
695 print *, 'm_icpp_patches.fpp:205: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
696# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
697
698# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
699 call flush (output_unit)
700# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
701 end block
702# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
703#endif
704# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
705 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
706# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
707
708# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
709
710# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
711
712# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
713#if defined(MFC_OpenACC)
714# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
715!$acc enter data create(x_coords, stored_values)
716# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
717#elif defined(MFC_OpenMP)
718# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
719!$omp target enter data map(always,alloc:x_coords, stored_values)
720# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
721#endif
722# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
723
724# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
725 ! Read data from all files
726# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
727 do f = 1, max_files
728# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
729 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
730# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
731 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
732# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
733
734# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
735 do iter = 1, xrows
736# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
737 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
738# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
739 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
740# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
741 end do
742# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
743 close (unit)
744# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
745 end do
746# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
747
748# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
749 ! Calculate offsets
750# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
751 domain_xstart = x_coords(1)
752# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
753 x_step = x_cc(1) - x_cc(0)
754# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
755 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)
756# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
757 global_offset_x = nint(abs(delta_x)/x_step)
758# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
759 case (3) ! 3D case - determine grid structure
760# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
761 ! Find yRows by counting rows with same x
762# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
763 read (unit2, *, iostat=ios2) x0, y0, dummy_z
764# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
765 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
766# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
767
768# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
769 yrows = 1
770# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
771 do
772# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
773 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
774# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
775 if (ios2 /= 0) exit
776# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
777 if (dummy_x == x0 .and. dummy_y /= y0) then
778# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
779 yrows = yrows + 1
780# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
781 else
782# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
783 exit
784# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
785 end if
786# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
787 end do
788# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
789 close (unit2)
790# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
791
792# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
793 ! Count total rows
794# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
795 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
796# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
797 nrows = 0
798# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
799 do
800# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
801 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
802# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
803 if (ios2 /= 0) exit
804# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
805 nrows = nrows + 1
806# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
807 end do
808# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
809 close (unit2)
810# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
811
812# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
813 xrows = nrows/yrows
814# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
815#ifdef MFC_DEBUG
816# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
817 block
818# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
819 use iso_fortran_env, only: output_unit
820# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
821
822# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
823 print *, 'm_icpp_patches.fpp:205: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
824# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
825
826# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
827 call flush (output_unit)
828# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
829 end block
830# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
831#endif
832# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
833 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
834# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
835
836# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
837
838# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
839
840# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
841
842# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
843#if defined(MFC_OpenACC)
844# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
845!$acc enter data create(x_coords, y_coords, stored_values)
846# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
847#elif defined(MFC_OpenMP)
848# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
849!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
850# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
851#endif
852# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
853 index_x = i
854# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
855 index_y = j
856# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
857
858# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
859 ! Read all files
860# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
861 do f = 1, max_files
862# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
863 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
864# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
865 if (ios /= 0) then
866# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
867 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
868# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
869 cycle
870# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
871 end if
872# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
873
874# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
875 iter = 0
876# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
877 do iix = 1, xrows
878# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
879 do iiy = 1, yrows
880# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
881 iter = iter + 1
882# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
883 if (f == 1) then
884# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
885 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
886# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
887 else
888# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
889 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
890# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
891 end if
892# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
893 if (ios /= 0) call s_mpi_abort("Error reading data")
894# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
895 end do
896# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
897 end do
898# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
899 close (unit)
900# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
901 end do
902# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
903
904# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
905 ! Calculate offsets
906# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
907 x_step = x_cc(1) - x_cc(0)
908# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
909 y_step = y_cc(1) - y_cc(0)
910# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
911 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
912# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
913 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
914# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
915 global_offset_x = nint(abs(delta_x)/x_step)
916# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
917 global_offset_y = nint(abs(delta_y)/y_step)
918# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
919 end select
920# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
921
922# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
923 files_loaded = .true.
924# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
925 end if
926# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
927
928# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
929 ! Data assignment
930# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
931 select case (num_dims)
932# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
933 case (1)
934# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
935 idx = i + 1 + global_offset_x
936# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
937 do f = 1, sys_size
938# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
939 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
940# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
941 end do
942# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
943 case (2)
944# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
945 idx = i + 1 + global_offset_x - index_x
946# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
947 do f = 1, sys_size - 1
948# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
949 jump = merge(1, 0, f >= momxe)
950# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
951 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
952# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
953 end do
954# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
955 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
956# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
957 case (3)
958# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
959 idx = i + 1 + global_offset_x - index_x
960# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
961 idy = j + 1 + global_offset_y - index_y
962# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
963 do f = 1, sys_size - 1
964# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
965 jump = merge(1, 0, f >= momxe)
966# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
967 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
968# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
969 end do
970# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
971 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
972# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
973 end select
974# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
975 case (180) ! Shu-Osher problem
976# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
977 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
978# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
979 ! 0.2*sin(5*x)"
980# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
981 if (patch_id == 2) then
982# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
983 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
984# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
985 end if
986# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
987 case (181) ! Titarev-Torro problem
988# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
989 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
990# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
991 ! "1 + 0.1*sin(20*x*pi)"
992# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
993 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
994# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
995 case (182) ! Multi-component diffusion
996# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
997 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
998# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
999 x_mid_diffu = 0.05_wp/2.0_wp
1000# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1001 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1002# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1003 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1004# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1005 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
1006# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1007 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1008# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1009 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
1010# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1011
1012# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1013 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1014# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1015 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1016# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1017 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1018# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1019 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1020# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1021
1022# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1023 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
1024# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1025 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
1026# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1027 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
1028# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1029 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
1030# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1031
1032# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1033 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1034# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1035
1036# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1037 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1038# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1039
1040# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1041 q_prim_vf(contxb)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1042# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1043 case default
1044# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1045 call s_int_to_str(patch_id, istr)
1046# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1047 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1048# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1049 end select
1050 end if
1051
1052 ! Updating the patch identities bookkeeping variable
1053 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1054 end if
1055 end do
1056 if (allocated(stored_values)) then
1057# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1058#ifdef MFC_DEBUG
1059# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1060 block
1061# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1062 use iso_fortran_env, only: output_unit
1063# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1064
1065# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1066 print *, 'm_icpp_patches.fpp:212: ', '@:DEALLOCATE(stored_values)'
1067# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1068
1069# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1070 call flush (output_unit)
1071# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1072 end block
1073# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1074#endif
1075# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1076
1077# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1078#if defined(MFC_OpenACC)
1079# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1080!$acc exit data delete(stored_values)
1081# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1082#elif defined(MFC_OpenMP)
1083# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1084!$omp target exit data map(release:stored_values)
1085# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1086#endif
1087# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1088 deallocate (stored_values)
1089# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1090#ifdef MFC_DEBUG
1091# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1092 block
1093# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1094 use iso_fortran_env, only: output_unit
1095# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1096
1097# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1098 print *, 'm_icpp_patches.fpp:212: ', '@:DEALLOCATE(x_coords)'
1099# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1100
1101# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1102 call flush (output_unit)
1103# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1104 end block
1105# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1106#endif
1107# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1108
1109# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1110#if defined(MFC_OpenACC)
1111# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1112!$acc exit data delete(x_coords)
1113# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1114#elif defined(MFC_OpenMP)
1115# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1116!$omp target exit data map(release:x_coords)
1117# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1118#endif
1119# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1120 deallocate (x_coords)
1121# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1122 end if
1123# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1124
1125# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1126 if (allocated(y_coords)) then
1127# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1128#ifdef MFC_DEBUG
1129# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1130 block
1131# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1132 use iso_fortran_env, only: output_unit
1133# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1134
1135# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1136 print *, 'm_icpp_patches.fpp:212: ', '@:DEALLOCATE(y_coords)'
1137# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1138
1139# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1140 call flush (output_unit)
1141# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1142 end block
1143# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1144#endif
1145# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1146
1147# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1148#if defined(MFC_OpenACC)
1149# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1150!$acc exit data delete(y_coords)
1151# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1152#elif defined(MFC_OpenMP)
1153# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1154!$omp target exit data map(release:y_coords)
1155# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1156#endif
1157# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1158 deallocate (y_coords)
1159# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1160 end if
1161
1162 end subroutine s_icpp_line_segment
1163
1164 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1165 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1166 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1167
1168 integer, intent(in) :: patch_id
1169
1170#ifdef MFC_MIXED_PRECISION
1171 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1172#else
1173 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1174#endif
1175 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1176 integer :: i, j, k !< Generic loop iterators
1177 real(wp) :: th, thickness, nturns, mya
1178 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1179
1180 integer :: xrows, yrows, nrows, iix, iiy, max_files
1181# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1182 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1183# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1184 real(wp) :: x_len, x_step, y_len, y_step
1185# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1186 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1187# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1188 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1189# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1190 real(wp) :: delta_x, delta_y
1191# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1192 character(len=100), dimension(sys_size) :: filenames !< Arrays to store all data from files
1193# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1194 character(len=200) :: errmsg
1195# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1196 real(wp), allocatable :: stored_values(:,:,:)
1197# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1198 real(wp), allocatable :: x_coords(:), y_coords(:)
1199# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1200 logical :: files_loaded = .false.
1201# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1202 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1203# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1204 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
1205# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1206 character(len=20) :: file_num_str !< For storing the file number as a string
1207# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1208 character(len=20) :: zeros_part !< For the trailing zeros part
1209# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1210 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
1211 ! Place any declaration of intermediate variables here
1212# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1213 real(wp) :: eps, eps_mhd, c_mhd
1214# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1215 real(wp) :: r, rmax, gam, umax, p0
1216# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1217 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1218# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1219 real(wp) :: factor
1220# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1221 real(wp) :: r0, alpha, r2
1222# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1223 real(wp) :: sina, cosa
1224# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1225 real(wp) :: r_sq
1226# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1227
1228# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1229 ! # 207
1230# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1231 real(wp) :: sigma, gauss1, gauss2
1232# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1233 ! # 208
1234# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1235 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1236# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237
1238# 233 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 eps = 1.e-9_wp
1240
1241 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1242 x_centroid = patch_icpp(patch_id)%x_centroid
1243 y_centroid = patch_icpp(patch_id)%y_centroid
1244 mya = patch_icpp(patch_id)%radius
1245 thickness = patch_icpp(patch_id)%length_x
1246 nturns = patch_icpp(patch_id)%length_y
1247
1248 !
1249 logic_grid = 0
1250 do k = 0, int(m*91*nturns)
1251 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1252
1253 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1254 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1255
1256 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1257 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1258
1259 do j = 0, n; do i = 0, m
1260 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) &
1261 & < spiral_y_max)) then
1262 logic_grid(i, j, 0) = 1
1263 end if
1264 end do; end do
1265 end do
1266
1267 do j = 0, n
1268 do i = 0, m
1269 if ((logic_grid(i, j, 0) == 1)) then
1270 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1271
1272
1273 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1274 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1275# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276 case (200) ! Two-fluid cubic interface
1277# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1279# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280 ! Volume Fractions
1281# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282 q_prim_vf(advxb)%sf(i, j, 0) = eps
1283# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
1285# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
1287# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
1289# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
1291# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292 end if
1293# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1294 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1295# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1296 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1297# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1298 rmax = 0.2_wp
1299# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1300
1301# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1302 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1303# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1304 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1305# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1306 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1307# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1308
1309# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1310 if (r < rmax) then
1311# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1312 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1313# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1314 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1315# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1316 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1317# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1318 else if (r < 2*rmax) then
1319# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1320 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1321# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1322 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1323# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1324 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
1325# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1326 else
1327# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1328 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1329# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1330 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1331# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1332 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1333# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1334 end if
1335# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1336 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1337# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1338 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1339# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1340 rmax = 0.2_wp
1341# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1342
1343# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1344 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1345# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1346 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1347# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1348 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1349# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1350
1351# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1352 if (r < rmax) then
1353# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1354 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1355# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1356 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1357# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1358 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1359# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1360 else if (r < 2*rmax) then
1361# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1362 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1363# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1364 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1365# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1366 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
1367# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1368 else
1369# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1370 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1371# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1372 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1373# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1374 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1375# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1376 end if
1377# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1378
1379# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1380 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
1381# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1382 case (204) ! Rayleigh-Taylor instability
1383# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1384 rhoh = 3._wp
1385# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1386 rhol = 1._wp
1387# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1388 pref = 1.e5_wp
1389# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1390 pint = pref
1391# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1392 h = 0.7_wp
1393# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1394 lam = 0.2_wp
1395# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1396 wl = 2._wp*pi/lam
1397# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1398 amp = 0.05_wp/wl
1399# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1400
1401# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1402 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1403# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1404
1405# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1406 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1407# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1408
1409# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1410 if (alph < eps) alph = eps
1411# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1412 if (alph > 1._wp - eps) alph = 1._wp - eps
1413# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1414
1415# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1416 if (y_cc(j) > inth) then
1417# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1418 q_prim_vf(advxb)%sf(i, j, 0) = alph
1419# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1420 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1421# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1422 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1423# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1424 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1425# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1426 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1427# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1428 else
1429# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1430 q_prim_vf(advxb)%sf(i, j, 0) = alph
1431# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1432 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1433# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1434 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1435# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1436 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1437# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1438 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1439# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1440 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1441# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1442 end if
1443# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1444 case (205) ! 2D lung wave interaction problem
1445# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1446 h = 0.0_wp ! non dim origin y
1447# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1448 lam = 1.0_wp ! non dim lambda
1449# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1450 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1451# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1452
1453# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1454 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1455# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1456
1457# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1458 if (y_cc(j) > inth) then
1459# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1460 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1461# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1462 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1463# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1464 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1465# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1466 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1467# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1468 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1469# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1470 end if
1471# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1472 case (206) ! 2D lung wave interaction problem - horizontal domain
1473# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1474 h = 0.0_wp ! non dim origin y
1475# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1476 lam = 1.0_wp ! non dim lambda
1477# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1478 amp = patch_icpp(patch_id)%a(2)
1479# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1480
1481# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1482 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1483# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1484
1485# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1486 if (x_cc(i) > intl) then ! this is the liquid
1487# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1488 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1489# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1490 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1491# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1492 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1493# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1494 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1495# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1496 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1497# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1498 end if
1499# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1500 case (207) ! Kelvin Helmholtz Instability
1501# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1502 sigma = 0.05_wp/sqrt(2.0_wp)
1503# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1504 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1505# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1506 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1507# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1508 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
1509# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1510 case (208) ! Richtmeyer Meshkov Instability
1511# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1512 lam = 1.0_wp
1513# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1514 eps = 1.0e-6_wp
1515# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1516 ei = 5.0_wp
1517# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1518 ! Smoothening function to smooth out sharp discontinuity in the interface
1519# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1520 if (x_cc(i) <= 0.7_wp*lam) then
1521# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1522 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1523# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1524 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1525# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1526 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1527# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1528 alpha_sf6 = 1.0_wp - alpha_air
1529# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1530 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
1531# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1532 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
1533# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1534 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
1535# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1536 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
1537# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1538 end if
1539# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1540 case (250) ! MHD Orszag-Tang vortex
1541# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1542 ! 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),
1543# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1544 ! sin(4*pi*x)/sqrt(4*pi), 0)
1545# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1546
1547# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1548 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1549# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1550 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1551# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1552
1553# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1554 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1555# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1556 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1557# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1558 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1559# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1560 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1561# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1562 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
1563# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1564 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
1565# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1566 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1567# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1568 ! Linear interpolation between r=0.08 and r=1.0
1569# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1570 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1571# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1572 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1573# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1574 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1575# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1576 else
1577# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1578 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
1579# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1580 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
1581# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1582 end if
1583# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1584
1585# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1586 ! case 252 is for the 2D MHD Rotor problem
1587# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1588 case (252) ! 2D MHD Rotor Problem
1589# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1590 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1591# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1592 !
1593# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1594 ! 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
1595# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1596 ! velocity w=20, giving v_tan=2 at r=0.1
1597# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1598
1599# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1600 ! Calculate distance squared from the center
1601# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1602 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1603# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1604
1605# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1606 ! inner radius of 0.1
1607# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1608 if (r_sq <= 0.1**2) then
1609# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1610 ! -- Inside the rotor -- Set density uniformly to 10
1611# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1612 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
1613# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1614
1615# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1616 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1617# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1618 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1619# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1620 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1621# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1622
1623# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1624 ! taper width of 0.015
1625# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1626 else if (r_sq <= 0.115**2) then
1627# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1628 ! linearly smooth the function between r = 0.1 and 0.115
1629# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1630 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1631# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1632
1633# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1634 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1635# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1636 q_prim_vf(momxb + 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)
1637# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1638 end if
1639# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1640 case (253) ! MHD Smooth Magnetic Vortex
1641# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1642 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1643# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1644 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1645# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1646
1647# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1648 ! velocity
1649# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1650 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1651# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1652 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1653# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1654
1655# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1656 ! magnetic field
1657# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1658 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1659# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1660 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1661# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1662
1663# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1664 ! pressure
1665# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1666 q_prim_vf(e_idx)%sf(i, j, &
1667# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1668 & 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)
1669# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1670 case (260) ! Gaussian Divergence Pulse
1671# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1672 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1673# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1674 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1675# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1676 ! initialized to zero everywhere.
1677# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1678
1679# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1680 eps_mhd = patch_icpp(patch_id)%a(2)
1681# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1682 sigma = patch_icpp(patch_id)%a(3)
1683# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1684 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1685# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1686
1687# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1688 ! B-field
1689# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1690 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1691# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1692 case (261) ! Blob
1693# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1694 r0 = 1._wp/sqrt(8._wp)
1695# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1696 r2 = x_cc(i)**2 + y_cc(j)**2
1697# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1698 r = sqrt(r2)
1699# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1700 alpha = r/r0
1701# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1702 if (alpha < 1) then
1703# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1704 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
1705# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1706 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
1707# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1708 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
1709# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1710 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
1711# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1712 end if
1713# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1714 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
1715# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1716 ! rotate by \alpha = atan(2)
1717# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1718 alpha = atan(2._wp)
1719# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1720 cosa = cos(alpha)
1721# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1722 sina = sin(alpha)
1723# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1724 ! projection along shock normal
1725# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1726 r = x_cc(i)*cosa + y_cc(j)*sina
1727# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1728
1729# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1730 if (r <= 0.5_wp) then
1731# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1732 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1733# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1734 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1735# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1736 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
1737# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1738 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
1739# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1740 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
1741# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1742 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1743# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1744 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1745# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1746 else
1747# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1748 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1749# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1750 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1751# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1752 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
1753# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1754 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
1755# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1756 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
1757# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1758 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1759# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1760 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1761# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1762 end if
1763# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1764 ! v^z and B^z remain zero by default
1765# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1766 case (270) ! 2D extrusion of 1D profile from external data
1767# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1768 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1769# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1770 if (.not. files_loaded) then
1771# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1772 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1773# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1774 do f = 1, max_files
1775# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1776 write (file_num_str, '(I0)') f
1777# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1778 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
1779# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1780 end do
1781# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1782
1783# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1784 ! Common file reading setup
1785# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1786 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1787# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1788 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
1789# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1790
1791# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1792 select case (num_dims)
1793# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1794 case (1, 2) ! 1D and 2D cases are similar
1795# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1796 ! Count lines
1797# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1798 line_count = 0
1799# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1800 do
1801# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1802 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1803# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1804 if (ios2 /= 0) exit
1805# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1806 line_count = line_count + 1
1807# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1808 end do
1809# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1810 close (unit2)
1811# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1812
1813# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1814 xrows = line_count
1815# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1816 yrows = 1
1817# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1818 index_x = 0
1819# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1820 if (num_dims == 2) index_x = i
1821# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1822#ifdef MFC_DEBUG
1823# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1824 block
1825# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1826 use iso_fortran_env, only: output_unit
1827# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1828
1829# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1830 print *, 'm_icpp_patches.fpp:268: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1831# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1832
1833# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1834 call flush (output_unit)
1835# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1836 end block
1837# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1838#endif
1839# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1840 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1841# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1842
1843# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1844
1845# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1846
1847# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1848#if defined(MFC_OpenACC)
1849# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1850!$acc enter data create(x_coords, stored_values)
1851# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1852#elif defined(MFC_OpenMP)
1853# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1854!$omp target enter data map(always,alloc:x_coords, stored_values)
1855# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1856#endif
1857# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1858
1859# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1860 ! Read data from all files
1861# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1862 do f = 1, max_files
1863# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1864 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1865# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1866 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
1867# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1868
1869# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1870 do iter = 1, xrows
1871# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1872 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
1873# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1874 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
1875# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1876 end do
1877# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1878 close (unit)
1879# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1880 end do
1881# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1882
1883# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1884 ! Calculate offsets
1885# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1886 domain_xstart = x_coords(1)
1887# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1888 x_step = x_cc(1) - x_cc(0)
1889# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1890 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)
1891# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1892 global_offset_x = nint(abs(delta_x)/x_step)
1893# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1894 case (3) ! 3D case - determine grid structure
1895# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1896 ! Find yRows by counting rows with same x
1897# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1898 read (unit2, *, iostat=ios2) x0, y0, dummy_z
1899# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1900 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
1901# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1902
1903# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1904 yrows = 1
1905# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1906 do
1907# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1908 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1909# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1910 if (ios2 /= 0) exit
1911# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1912 if (dummy_x == x0 .and. dummy_y /= y0) then
1913# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1914 yrows = yrows + 1
1915# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1916 else
1917# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1918 exit
1919# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1920 end if
1921# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1922 end do
1923# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1924 close (unit2)
1925# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1926
1927# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1928 ! Count total rows
1929# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1930 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1931# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1932 nrows = 0
1933# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1934 do
1935# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1936 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1937# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1938 if (ios2 /= 0) exit
1939# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1940 nrows = nrows + 1
1941# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1942 end do
1943# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1944 close (unit2)
1945# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1946
1947# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1948 xrows = nrows/yrows
1949# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1950#ifdef MFC_DEBUG
1951# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1952 block
1953# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1954 use iso_fortran_env, only: output_unit
1955# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1956
1957# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1958 print *, 'm_icpp_patches.fpp:268: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
1959# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1960
1961# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1962 call flush (output_unit)
1963# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1964 end block
1965# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1966#endif
1967# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1968 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
1969# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1970
1971# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1972
1973# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1974
1975# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1976
1977# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1978#if defined(MFC_OpenACC)
1979# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1980!$acc enter data create(x_coords, y_coords, stored_values)
1981# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1982#elif defined(MFC_OpenMP)
1983# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1984!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
1985# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1986#endif
1987# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1988 index_x = i
1989# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1990 index_y = j
1991# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1992
1993# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1994 ! Read all files
1995# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1996 do f = 1, max_files
1997# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1998 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1999# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2000 if (ios /= 0) then
2001# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2002 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2003# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2004 cycle
2005# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2006 end if
2007# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2008
2009# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2010 iter = 0
2011# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2012 do iix = 1, xrows
2013# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2014 do iiy = 1, yrows
2015# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2016 iter = iter + 1
2017# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2018 if (f == 1) then
2019# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2020 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2021# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2022 else
2023# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2024 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2025# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2026 end if
2027# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2028 if (ios /= 0) call s_mpi_abort("Error reading data")
2029# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2030 end do
2031# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2032 end do
2033# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2034 close (unit)
2035# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2036 end do
2037# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2038
2039# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2040 ! Calculate offsets
2041# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2042 x_step = x_cc(1) - x_cc(0)
2043# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2044 y_step = y_cc(1) - y_cc(0)
2045# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2046 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2047# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2048 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2049# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2050 global_offset_x = nint(abs(delta_x)/x_step)
2051# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2052 global_offset_y = nint(abs(delta_y)/y_step)
2053# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2054 end select
2055# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2056
2057# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2058 files_loaded = .true.
2059# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2060 end if
2061# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2062
2063# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2064 ! Data assignment
2065# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2066 select case (num_dims)
2067# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2068 case (1)
2069# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2070 idx = i + 1 + global_offset_x
2071# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2072 do f = 1, sys_size
2073# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2074 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2075# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2076 end do
2077# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2078 case (2)
2079# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2080 idx = i + 1 + global_offset_x - index_x
2081# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2082 do f = 1, sys_size - 1
2083# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2084 jump = merge(1, 0, f >= momxe)
2085# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2086 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2087# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2088 end do
2089# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2090 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
2091# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2092 case (3)
2093# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2094 idx = i + 1 + global_offset_x - index_x
2095# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2096 idy = j + 1 + global_offset_y - index_y
2097# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2098 do f = 1, sys_size - 1
2099# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2100 jump = merge(1, 0, f >= momxe)
2101# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2102 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2103# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2104 end do
2105# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2106 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
2107# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2108 end select
2109# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2110 case (280) ! Isentropic vortex
2111# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2112 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
2113# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2114 ! geometry 2
2115# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2116 if (patch_id == 1) then
2117# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2118 q_prim_vf(e_idx)%sf(i, j, &
2119# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2120 & 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) &
2121# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2122 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
2123# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2124 q_prim_vf(contxb + 0)%sf(i, j, &
2125# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2126 & 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) &
2127# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2128 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
2129# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2130 q_prim_vf(momxb + 0)%sf(i, j, &
2131# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2132 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
2133# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2134 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2135# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2136 q_prim_vf(momxb + 1)%sf(i, j, &
2137# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2138 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
2139# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2140 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2141# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2142 end if
2143# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2144 case (281) ! Acoustic pulse
2145# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2146 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
2147# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2148 ! geometry 2
2149# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2150 if (patch_id == 2) then
2151# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2152 q_prim_vf(e_idx)%sf(i, j, &
2153# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2154 & 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))
2155# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2156 q_prim_vf(contxb + 0)%sf(i, j, &
2157# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2158 & 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))
2159# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2160 end if
2161# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2162 case (282) ! Zero-circulation vortex
2163# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2164 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
2165# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2166 ! geometry 2
2167# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2168 if (patch_id == 2) then
2169# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2170 q_prim_vf(e_idx)%sf(i, j, &
2171# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2172 & 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))
2173# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2174 q_prim_vf(contxb + 0)%sf(i, j, &
2175# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2176 & 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))
2177# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2178 q_prim_vf(momxb + 0)%sf(i, j, &
2179# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2180 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2181# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2182 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2183# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2184 end if
2185# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2186 case default
2187# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2188 if (proc_rank == 0) then
2189# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2190 call s_int_to_str(patch_id, istr)
2191# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2192 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
2193# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2194 end if
2195# 268 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2196 end select
2197 end if
2198
2199 ! Updating the patch identities bookkeeping variable
2200 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2201 end if
2202 end do
2203 end do
2204 if (allocated(stored_values)) then
2205# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2206#ifdef MFC_DEBUG
2207# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2208 block
2209# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2210 use iso_fortran_env, only: output_unit
2211# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2212
2213# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2214 print *, 'm_icpp_patches.fpp:276: ', '@:DEALLOCATE(stored_values)'
2215# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2216
2217# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2218 call flush (output_unit)
2219# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2220 end block
2221# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2222#endif
2223# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2224
2225# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2226#if defined(MFC_OpenACC)
2227# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2228!$acc exit data delete(stored_values)
2229# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2230#elif defined(MFC_OpenMP)
2231# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2232!$omp target exit data map(release:stored_values)
2233# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2234#endif
2235# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2236 deallocate (stored_values)
2237# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2238#ifdef MFC_DEBUG
2239# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2240 block
2241# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2242 use iso_fortran_env, only: output_unit
2243# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2244
2245# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2246 print *, 'm_icpp_patches.fpp:276: ', '@:DEALLOCATE(x_coords)'
2247# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2248
2249# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2250 call flush (output_unit)
2251# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2252 end block
2253# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2254#endif
2255# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2256
2257# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2258#if defined(MFC_OpenACC)
2259# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2260!$acc exit data delete(x_coords)
2261# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2262#elif defined(MFC_OpenMP)
2263# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2264!$omp target exit data map(release:x_coords)
2265# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2266#endif
2267# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2268 deallocate (x_coords)
2269# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2270 end if
2271# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2272
2273# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2274 if (allocated(y_coords)) then
2275# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2276#ifdef MFC_DEBUG
2277# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2278 block
2279# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2280 use iso_fortran_env, only: output_unit
2281# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2282
2283# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2284 print *, 'm_icpp_patches.fpp:276: ', '@:DEALLOCATE(y_coords)'
2285# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2286
2287# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2288 call flush (output_unit)
2289# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2290 end block
2291# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2292#endif
2293# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2294
2295# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2296#if defined(MFC_OpenACC)
2297# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2298!$acc exit data delete(y_coords)
2299# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2300#elif defined(MFC_OpenMP)
2301# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2302!$omp target exit data map(release:y_coords)
2303# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2304#endif
2305# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2306 deallocate (y_coords)
2307# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2308 end if
2309
2310 end subroutine s_icpp_spiral
2311
2312 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
2313 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
2314 !! its boundary.
2315 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2316
2317 integer, intent(in) :: patch_id
2318
2319#ifdef MFC_MIXED_PRECISION
2320 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2321#else
2322 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2323#endif
2324 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2325 real(wp) :: radius
2326 integer :: i, j, k !< Generic loop iterators
2327
2328 integer :: xRows, yRows, nRows, iix, iiy, max_files
2329# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2330 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2331# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2332 real(wp) :: x_len, x_step, y_len, y_step
2333# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2334 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2335# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2336 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
2337# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2338 real(wp) :: delta_x, delta_y
2339# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2340 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
2341# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2342 character(len=200) :: errmsg
2343# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2344 real(wp), allocatable :: stored_values(:,:,:)
2345# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2346 real(wp), allocatable :: x_coords(:), y_coords(:)
2347# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2348 logical :: files_loaded = .false.
2349# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2350 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2351# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2352 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
2353# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2354 character(len=20) :: file_num_str !< For storing the file number as a string
2355# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2356 character(len=20) :: zeros_part !< For the trailing zeros part
2357# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2358 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
2359 ! Place any declaration of intermediate variables here
2360# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361 real(wp) :: eps, eps_mhd, C_mhd
2362# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363 real(wp) :: r, rmax, gam, umax, p0
2364# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2366# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367 real(wp) :: factor
2368# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369 real(wp) :: r0, alpha, r2
2370# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 real(wp) :: sinA, cosA
2372# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373 real(wp) :: r_sq
2374# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375
2376# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377 ! # 207
2378# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379 real(wp) :: sigma, gauss1, gauss2
2380# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381 ! # 208
2382# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2384# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385
2386# 297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387 eps = 1.e-9_wp
2388
2389 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
2390
2391 x_centroid = patch_icpp(patch_id)%x_centroid
2392 y_centroid = patch_icpp(patch_id)%y_centroid
2393 radius = patch_icpp(patch_id)%radius
2394 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2395 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2396
2397 ! Initialize eta=1; modified if smoothing is enabled
2398 eta = 1._wp
2399
2400 ! Assign patch vars if cell is covered and patch has write permission
2401
2402 do j = 0, n
2403 do i = 0, m
2404 if (patch_icpp(patch_id)%smoothen) then
2405 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
2406 eta = tanh(smooth_coeff/min(dx, &
2407 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
2408 end if
2409
2410 if (((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2 <= radius**2 .and. patch_icpp(patch_id) &
2411 & %alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
2412 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
2413
2414
2415 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2416 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2417# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2418 case (200) ! Two-fluid cubic interface
2419# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2420 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2421# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2422 ! Volume Fractions
2423# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2424 q_prim_vf(advxb)%sf(i, j, 0) = eps
2425# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2426 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
2427# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2428 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
2429# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2430 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
2431# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2432 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
2433# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2434 end if
2435# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2436 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2437# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2438 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2439# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2440 rmax = 0.2_wp
2441# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2442
2443# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2444 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2445# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2446 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2447# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2448 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2449# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2450
2451# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2452 if (r < rmax) then
2453# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2454 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2455# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2456 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2457# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2458 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2459# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2460 else if (r < 2*rmax) then
2461# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2462 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2463# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2464 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2465# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2466 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
2467# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2468 else
2469# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2470 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2471# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2472 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2473# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2474 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2475# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2476 end if
2477# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2478 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2479# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2480 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2481# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2482 rmax = 0.2_wp
2483# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2484
2485# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2486 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2487# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2488 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2489# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2490 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2491# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2492
2493# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2494 if (r < rmax) then
2495# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2496 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2497# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2498 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2499# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2500 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2501# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2502 else if (r < 2*rmax) then
2503# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2504 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2505# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2506 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2507# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2508 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
2509# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2510 else
2511# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2512 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2513# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2514 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2515# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2516 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2517# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2518 end if
2519# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2520
2521# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2522 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
2523# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2524 case (204) ! Rayleigh-Taylor instability
2525# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2526 rhoh = 3._wp
2527# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2528 rhol = 1._wp
2529# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2530 pref = 1.e5_wp
2531# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2532 pint = pref
2533# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2534 h = 0.7_wp
2535# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2536 lam = 0.2_wp
2537# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2538 wl = 2._wp*pi/lam
2539# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2540 amp = 0.05_wp/wl
2541# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2542
2543# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2544 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2545# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2546
2547# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2548 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2549# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2550
2551# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2552 if (alph < eps) alph = eps
2553# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2554 if (alph > 1._wp - eps) alph = 1._wp - eps
2555# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2556
2557# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2558 if (y_cc(j) > inth) then
2559# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2560 q_prim_vf(advxb)%sf(i, j, 0) = alph
2561# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2562 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2563# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2564 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2565# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2566 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2567# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2568 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2569# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2570 else
2571# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2572 q_prim_vf(advxb)%sf(i, j, 0) = alph
2573# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2574 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2575# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2576 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2577# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2578 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2579# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2580 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2581# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2582 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2583# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2584 end if
2585# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2586 case (205) ! 2D lung wave interaction problem
2587# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2588 h = 0.0_wp ! non dim origin y
2589# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2590 lam = 1.0_wp ! non dim lambda
2591# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2592 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
2593# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2594
2595# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2596 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2597# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2598
2599# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2600 if (y_cc(j) > inth) then
2601# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2602 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2603# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2604 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2605# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2606 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2607# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2608 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2609# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2610 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2611# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2612 end if
2613# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2614 case (206) ! 2D lung wave interaction problem - horizontal domain
2615# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2616 h = 0.0_wp ! non dim origin y
2617# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2618 lam = 1.0_wp ! non dim lambda
2619# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2620 amp = patch_icpp(patch_id)%a(2)
2621# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2622
2623# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2624 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2625# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2626
2627# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2628 if (x_cc(i) > intl) then ! this is the liquid
2629# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2630 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2631# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2632 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2633# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2634 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2635# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2636 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2637# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2638 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2639# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2640 end if
2641# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2642 case (207) ! Kelvin Helmholtz Instability
2643# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2644 sigma = 0.05_wp/sqrt(2.0_wp)
2645# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2646 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2647# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2648 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2649# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2650 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
2651# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2652 case (208) ! Richtmeyer Meshkov Instability
2653# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2654 lam = 1.0_wp
2655# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2656 eps = 1.0e-6_wp
2657# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2658 ei = 5.0_wp
2659# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2660 ! Smoothening function to smooth out sharp discontinuity in the interface
2661# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2662 if (x_cc(i) <= 0.7_wp*lam) then
2663# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2664 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2665# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2666 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2667# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2668 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2669# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2670 alpha_sf6 = 1.0_wp - alpha_air
2671# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2672 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
2673# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2674 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
2675# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2676 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
2677# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2678 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
2679# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2680 end if
2681# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2682 case (250) ! MHD Orszag-Tang vortex
2683# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2684 ! 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),
2685# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2686 ! sin(4*pi*x)/sqrt(4*pi), 0)
2687# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2688
2689# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2690 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2691# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2692 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2693# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2694
2695# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2696 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2697# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2698 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2699# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2700 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2701# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2702 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2703# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2704 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
2705# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2706 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
2707# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2708 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2709# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2710 ! Linear interpolation between r=0.08 and r=1.0
2711# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2712 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2713# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2714 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2715# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2716 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2717# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2718 else
2719# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2720 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
2721# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2722 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
2723# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2724 end if
2725# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2726
2727# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2728 ! case 252 is for the 2D MHD Rotor problem
2729# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2730 case (252) ! 2D MHD Rotor Problem
2731# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2732 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
2733# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2734 !
2735# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2736 ! 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
2737# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2738 ! velocity w=20, giving v_tan=2 at r=0.1
2739# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2740
2741# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2742 ! Calculate distance squared from the center
2743# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2744 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2745# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2746
2747# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2748 ! inner radius of 0.1
2749# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2750 if (r_sq <= 0.1**2) then
2751# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2752 ! -- Inside the rotor -- Set density uniformly to 10
2753# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2754 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
2755# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2756
2757# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2758 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
2759# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2760 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2761# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2762 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2763# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2764
2765# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2766 ! taper width of 0.015
2767# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2768 else if (r_sq <= 0.115**2) then
2769# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2770 ! linearly smooth the function between r = 0.1 and 0.115
2771# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2772 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2773# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2774
2775# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2776 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2777# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2778 q_prim_vf(momxb + 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)
2779# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2780 end if
2781# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2782 case (253) ! MHD Smooth Magnetic Vortex
2783# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2784 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
2785# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2786 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
2787# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2788
2789# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2790 ! velocity
2791# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2792 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
2793# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2794 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
2795# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2796
2797# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2798 ! magnetic field
2799# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2800 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
2801# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2802 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
2803# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2804
2805# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2806 ! pressure
2807# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2808 q_prim_vf(e_idx)%sf(i, j, &
2809# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2810 & 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)
2811# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2812 case (260) ! Gaussian Divergence Pulse
2813# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2814 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
2815# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2816 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
2817# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2818 ! initialized to zero everywhere.
2819# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2820
2821# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2822 eps_mhd = patch_icpp(patch_id)%a(2)
2823# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2824 sigma = patch_icpp(patch_id)%a(3)
2825# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2826 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
2827# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2828
2829# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2830 ! B-field
2831# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2832 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
2833# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2834 case (261) ! Blob
2835# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2836 r0 = 1._wp/sqrt(8._wp)
2837# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2838 r2 = x_cc(i)**2 + y_cc(j)**2
2839# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2840 r = sqrt(r2)
2841# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2842 alpha = r/r0
2843# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2844 if (alpha < 1) then
2845# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2846 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
2847# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2848 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
2849# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2850 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
2851# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2852 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
2853# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2854 end if
2855# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2856 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
2857# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2858 ! rotate by \alpha = atan(2)
2859# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2860 alpha = atan(2._wp)
2861# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2862 cosa = cos(alpha)
2863# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2864 sina = sin(alpha)
2865# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2866 ! projection along shock normal
2867# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2868 r = x_cc(i)*cosa + y_cc(j)*sina
2869# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2870
2871# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2872 if (r <= 0.5_wp) then
2873# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2874 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
2875# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2876 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
2877# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2878 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
2879# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2880 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
2881# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2882 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
2883# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2884 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
2885# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2886 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
2887# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2888 else
2889# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2890 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
2891# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2892 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
2893# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2894 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
2895# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2896 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
2897# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2898 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
2899# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2900 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
2901# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2902 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
2903# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2904 end if
2905# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2906 ! v^z and B^z remain zero by default
2907# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2908 case (270) ! 2D extrusion of 1D profile from external data
2909# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2910 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
2911# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2912 if (.not. files_loaded) then
2913# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2914 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
2915# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2916 do f = 1, max_files
2917# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2918 write (file_num_str, '(I0)') f
2919# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2920 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
2921# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2922 end do
2923# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2924
2925# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2926 ! Common file reading setup
2927# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2928 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2929# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2930 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
2931# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2932
2933# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2934 select case (num_dims)
2935# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2936 case (1, 2) ! 1D and 2D cases are similar
2937# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2938 ! Count lines
2939# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2940 line_count = 0
2941# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2942 do
2943# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2944 read (unit2, *, iostat=ios2) dummy_x, dummy_y
2945# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2946 if (ios2 /= 0) exit
2947# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2948 line_count = line_count + 1
2949# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2950 end do
2951# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2952 close (unit2)
2953# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2954
2955# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2956 xrows = line_count
2957# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2958 yrows = 1
2959# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2960 index_x = 0
2961# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2962 if (num_dims == 2) index_x = i
2963# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2964#ifdef MFC_DEBUG
2965# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2966 block
2967# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2968 use iso_fortran_env, only: output_unit
2969# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2970
2971# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2972 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2973# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2974
2975# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2976 call flush (output_unit)
2977# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2978 end block
2979# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2980#endif
2981# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2982 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2983# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2984
2985# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2986
2987# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2988
2989# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2990#if defined(MFC_OpenACC)
2991# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2992!$acc enter data create(x_coords, stored_values)
2993# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2994#elif defined(MFC_OpenMP)
2995# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2996!$omp target enter data map(always,alloc:x_coords, stored_values)
2997# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2998#endif
2999# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3000
3001# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3002 ! Read data from all files
3003# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3004 do f = 1, max_files
3005# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3006 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3007# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3008 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3009# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3010
3011# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3012 do iter = 1, xrows
3013# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3014 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3015# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3016 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3017# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3018 end do
3019# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3020 close (unit)
3021# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3022 end do
3023# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3024
3025# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3026 ! Calculate offsets
3027# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3028 domain_xstart = x_coords(1)
3029# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3030 x_step = x_cc(1) - x_cc(0)
3031# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3032 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)
3033# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3034 global_offset_x = nint(abs(delta_x)/x_step)
3035# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3036 case (3) ! 3D case - determine grid structure
3037# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3038 ! Find yRows by counting rows with same x
3039# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3040 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3041# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3042 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3043# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3044
3045# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3046 yrows = 1
3047# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3048 do
3049# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3050 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3051# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3052 if (ios2 /= 0) exit
3053# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3054 if (dummy_x == x0 .and. dummy_y /= y0) then
3055# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3056 yrows = yrows + 1
3057# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3058 else
3059# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3060 exit
3061# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3062 end if
3063# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3064 end do
3065# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3066 close (unit2)
3067# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3068
3069# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3070 ! Count total rows
3071# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3072 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3073# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3074 nrows = 0
3075# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3076 do
3077# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3078 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3079# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3080 if (ios2 /= 0) exit
3081# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3082 nrows = nrows + 1
3083# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3084 end do
3085# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3086 close (unit2)
3087# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3088
3089# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3090 xrows = nrows/yrows
3091# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3092#ifdef MFC_DEBUG
3093# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3094 block
3095# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3096 use iso_fortran_env, only: output_unit
3097# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3098
3099# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3100 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3101# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3102
3103# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3104 call flush (output_unit)
3105# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3106 end block
3107# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3108#endif
3109# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3110 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3111# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3112
3113# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3114
3115# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3116
3117# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3118
3119# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3120#if defined(MFC_OpenACC)
3121# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3122!$acc enter data create(x_coords, y_coords, stored_values)
3123# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3124#elif defined(MFC_OpenMP)
3125# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3126!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3127# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3128#endif
3129# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3130 index_x = i
3131# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3132 index_y = j
3133# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3134
3135# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3136 ! Read all files
3137# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3138 do f = 1, max_files
3139# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3140 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3141# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3142 if (ios /= 0) then
3143# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3144 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3145# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3146 cycle
3147# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3148 end if
3149# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3150
3151# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3152 iter = 0
3153# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3154 do iix = 1, xrows
3155# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3156 do iiy = 1, yrows
3157# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3158 iter = iter + 1
3159# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3160 if (f == 1) then
3161# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3162 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3163# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3164 else
3165# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3166 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3167# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3168 end if
3169# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3170 if (ios /= 0) call s_mpi_abort("Error reading data")
3171# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3172 end do
3173# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3174 end do
3175# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3176 close (unit)
3177# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3178 end do
3179# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3180
3181# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3182 ! Calculate offsets
3183# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3184 x_step = x_cc(1) - x_cc(0)
3185# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3186 y_step = y_cc(1) - y_cc(0)
3187# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3188 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3189# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3190 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3191# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3192 global_offset_x = nint(abs(delta_x)/x_step)
3193# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3194 global_offset_y = nint(abs(delta_y)/y_step)
3195# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3196 end select
3197# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3198
3199# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3200 files_loaded = .true.
3201# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3202 end if
3203# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3204
3205# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3206 ! Data assignment
3207# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3208 select case (num_dims)
3209# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3210 case (1)
3211# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3212 idx = i + 1 + global_offset_x
3213# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3214 do f = 1, sys_size
3215# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3216 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3217# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3218 end do
3219# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3220 case (2)
3221# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3222 idx = i + 1 + global_offset_x - index_x
3223# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3224 do f = 1, sys_size - 1
3225# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3226 jump = merge(1, 0, f >= momxe)
3227# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3228 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3229# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3230 end do
3231# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3232 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
3233# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3234 case (3)
3235# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3236 idx = i + 1 + global_offset_x - index_x
3237# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3238 idy = j + 1 + global_offset_y - index_y
3239# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3240 do f = 1, sys_size - 1
3241# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3242 jump = merge(1, 0, f >= momxe)
3243# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3244 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3245# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3246 end do
3247# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3248 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
3249# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3250 end select
3251# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3252 case (280) ! Isentropic vortex
3253# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3254 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3255# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3256 ! geometry 2
3257# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3258 if (patch_id == 1) then
3259# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3260 q_prim_vf(e_idx)%sf(i, j, &
3261# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3262 & 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) &
3263# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3264 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3265# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3266 q_prim_vf(contxb + 0)%sf(i, j, &
3267# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3268 & 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) &
3269# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3270 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3271# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3272 q_prim_vf(momxb + 0)%sf(i, j, &
3273# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3274 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
3275# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3276 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3277# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3278 q_prim_vf(momxb + 1)%sf(i, j, &
3279# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3280 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
3281# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3282 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3283# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3284 end if
3285# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3286 case (281) ! Acoustic pulse
3287# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3288 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3289# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3290 ! geometry 2
3291# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3292 if (patch_id == 2) then
3293# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3294 q_prim_vf(e_idx)%sf(i, j, &
3295# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3296 & 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))
3297# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3298 q_prim_vf(contxb + 0)%sf(i, j, &
3299# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3300 & 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))
3301# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3302 end if
3303# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3304 case (282) ! Zero-circulation vortex
3305# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3306 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
3307# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3308 ! geometry 2
3309# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3310 if (patch_id == 2) then
3311# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3312 q_prim_vf(e_idx)%sf(i, j, &
3313# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3314 & 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))
3315# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3316 q_prim_vf(contxb + 0)%sf(i, j, &
3317# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3318 & 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))
3319# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3320 q_prim_vf(momxb + 0)%sf(i, j, &
3321# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3322 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3323# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3324 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3325# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3326 end if
3327# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3328 case default
3329# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3330 if (proc_rank == 0) then
3331# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3332 call s_int_to_str(patch_id, istr)
3333# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3334 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
3335# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3336 end if
3337# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3338 end select
3339 end if
3340 end if
3341 end do
3342 end do
3343 if (allocated(stored_values)) then
3344# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3345#ifdef MFC_DEBUG
3346# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3347 block
3348# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3349 use iso_fortran_env, only: output_unit
3350# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3351
3352# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3353 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(stored_values)'
3354# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3355
3356# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3357 call flush (output_unit)
3358# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3359 end block
3360# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3361#endif
3362# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3363
3364# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3365#if defined(MFC_OpenACC)
3366# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3367!$acc exit data delete(stored_values)
3368# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3369#elif defined(MFC_OpenMP)
3370# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3371!$omp target exit data map(release:stored_values)
3372# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3373#endif
3374# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3375 deallocate (stored_values)
3376# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3377#ifdef MFC_DEBUG
3378# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3379 block
3380# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3381 use iso_fortran_env, only: output_unit
3382# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3383
3384# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3385 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(x_coords)'
3386# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3387
3388# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3389 call flush (output_unit)
3390# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3391 end block
3392# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3393#endif
3394# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3395
3396# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3397#if defined(MFC_OpenACC)
3398# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3399!$acc exit data delete(x_coords)
3400# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3401#elif defined(MFC_OpenMP)
3402# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3403!$omp target exit data map(release:x_coords)
3404# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3405#endif
3406# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3407 deallocate (x_coords)
3408# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3409 end if
3410# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3411
3412# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3413 if (allocated(y_coords)) then
3414# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3415#ifdef MFC_DEBUG
3416# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3417 block
3418# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3419 use iso_fortran_env, only: output_unit
3420# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3421
3422# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3423 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(y_coords)'
3424# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3425
3426# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3427 call flush (output_unit)
3428# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3429 end block
3430# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3431#endif
3432# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3433
3434# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3435#if defined(MFC_OpenACC)
3436# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3437!$acc exit data delete(y_coords)
3438# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3439#elif defined(MFC_OpenMP)
3440# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3441!$omp target exit data map(release:y_coords)
3442# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3443#endif
3444# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3445 deallocate (y_coords)
3446# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3447 end if
3448
3449 end subroutine s_icpp_circle
3450
3451 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
3452 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3453
3454 ! Patch identifier
3455 integer, intent(in) :: patch_id
3456
3457#ifdef MFC_MIXED_PRECISION
3458 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3459#else
3460 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3461#endif
3462 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3463
3464 ! Generic loop iterators
3465 integer :: i, j, k
3466 real(wp) :: radius, myr, thickness
3467
3468 integer :: xRows, yRows, nRows, iix, iiy, max_files
3469# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3470 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3471# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3472 real(wp) :: x_len, x_step, y_len, y_step
3473# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3474 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3475# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3476 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
3477# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3478 real(wp) :: delta_x, delta_y
3479# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3480 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
3481# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3482 character(len=200) :: errmsg
3483# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3484 real(wp), allocatable :: stored_values(:,:,:)
3485# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3486 real(wp), allocatable :: x_coords(:), y_coords(:)
3487# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3488 logical :: files_loaded = .false.
3489# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3490 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3491# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3492 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
3493# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3494 character(len=20) :: file_num_str !< For storing the file number as a string
3495# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3496 character(len=20) :: zeros_part !< For the trailing zeros part
3497# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3498 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
3499 ! Place any declaration of intermediate variables here
3500# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3501 real(wp) :: eps, eps_mhd, C_mhd
3502# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3503 real(wp) :: r, rmax, gam, umax, p0
3504# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3505 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3506# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3507 real(wp) :: factor
3508# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3509 real(wp) :: r0, alpha, r2
3510# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3511 real(wp) :: sinA, cosA
3512# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3513 real(wp) :: r_sq
3514# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3515
3516# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3517 ! # 207
3518# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3519 real(wp) :: sigma, gauss1, gauss2
3520# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3521 ! # 208
3522# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3523 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3524# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3525
3526# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3527 eps = 1.e-9_wp
3528
3529 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
3530 x_centroid = patch_icpp(patch_id)%x_centroid
3531 y_centroid = patch_icpp(patch_id)%y_centroid
3532 radius = patch_icpp(patch_id)%radius
3533 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3534 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3535 thickness = patch_icpp(patch_id)%epsilon
3536
3537 ! Initialize eta=1; modified if smoothing is enabled
3538 eta = 1._wp
3539
3540 ! Assign patch vars if cell is covered and patch has write permission
3541 do j = 0, n
3542 do i = 0, m
3543 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
3544
3545 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp .and. patch_icpp(patch_id) &
3546 & %alter_patch(patch_id_fp(i, j, 0))) then
3547 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
3548
3549
3550 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3551 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3552# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3553 case (200) ! Two-fluid cubic interface
3554# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3555 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3556# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3557 ! Volume Fractions
3558# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3559 q_prim_vf(advxb)%sf(i, j, 0) = eps
3560# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3561 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
3562# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3563 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
3564# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3565 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
3566# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3567 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
3568# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3569 end if
3570# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3571 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3572# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3573 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3574# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3575 rmax = 0.2_wp
3576# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3577
3578# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3579 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3580# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3581 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3582# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3583 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3584# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3585
3586# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3587 if (r < rmax) then
3588# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3589 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3590# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3591 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3592# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3593 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3594# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3595 else if (r < 2*rmax) then
3596# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3597 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3598# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3599 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3600# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3601 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
3602# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3603 else
3604# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3605 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3606# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3607 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3608# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3609 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
3610# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3611 end if
3612# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3613 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
3614# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3615 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3616# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3617 rmax = 0.2_wp
3618# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3619
3620# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3621 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3622# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3623 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3624# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3625 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3626# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3627
3628# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3629 if (r < rmax) then
3630# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3631 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3632# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3633 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3634# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3635 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3636# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3637 else if (r < 2*rmax) then
3638# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3639 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3640# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3641 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3642# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3643 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
3644# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3645 else
3646# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3647 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3648# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3649 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3650# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3651 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
3652# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3653 end if
3654# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3655
3656# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3657 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
3658# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3659 case (204) ! Rayleigh-Taylor instability
3660# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3661 rhoh = 3._wp
3662# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3663 rhol = 1._wp
3664# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3665 pref = 1.e5_wp
3666# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3667 pint = pref
3668# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3669 h = 0.7_wp
3670# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3671 lam = 0.2_wp
3672# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3673 wl = 2._wp*pi/lam
3674# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3675 amp = 0.05_wp/wl
3676# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3677
3678# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3679 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
3680# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3681
3682# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3683 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
3684# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3685
3686# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3687 if (alph < eps) alph = eps
3688# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3689 if (alph > 1._wp - eps) alph = 1._wp - eps
3690# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3691
3692# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3693 if (y_cc(j) > inth) then
3694# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3695 q_prim_vf(advxb)%sf(i, j, 0) = alph
3696# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3697 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3698# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3699 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3700# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3701 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3702# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3703 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
3704# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3705 else
3706# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3707 q_prim_vf(advxb)%sf(i, j, 0) = alph
3708# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3709 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3710# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3711 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3712# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3713 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3714# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3715 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
3716# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3717 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
3718# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3719 end if
3720# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3721 case (205) ! 2D lung wave interaction problem
3722# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723 h = 0.0_wp ! non dim origin y
3724# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725 lam = 1.0_wp ! non dim lambda
3726# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
3728# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729
3730# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
3732# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733
3734# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735 if (y_cc(j) > inth) then
3736# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3738# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
3740# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
3742# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
3744# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
3746# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747 end if
3748# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3749 case (206) ! 2D lung wave interaction problem - horizontal domain
3750# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3751 h = 0.0_wp ! non dim origin y
3752# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3753 lam = 1.0_wp ! non dim lambda
3754# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3755 amp = patch_icpp(patch_id)%a(2)
3756# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3757
3758# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3759 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
3760# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3761
3762# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3763 if (x_cc(i) > intl) then ! this is the liquid
3764# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3765 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3766# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3767 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
3768# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3769 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
3770# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3771 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
3772# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3773 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
3774# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3775 end if
3776# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3777 case (207) ! Kelvin Helmholtz Instability
3778# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3779 sigma = 0.05_wp/sqrt(2.0_wp)
3780# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3781 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
3782# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3783 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
3784# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3785 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
3786# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787 case (208) ! Richtmeyer Meshkov Instability
3788# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789 lam = 1.0_wp
3790# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791 eps = 1.0e-6_wp
3792# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793 ei = 5.0_wp
3794# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795 ! Smoothening function to smooth out sharp discontinuity in the interface
3796# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797 if (x_cc(i) <= 0.7_wp*lam) then
3798# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
3800# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
3802# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3803 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
3804# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3805 alpha_sf6 = 1.0_wp - alpha_air
3806# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3807 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
3808# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3809 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
3810# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3811 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
3812# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3813 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
3814# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3815 end if
3816# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3817 case (250) ! MHD Orszag-Tang vortex
3818# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3819 ! 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),
3820# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3821 ! sin(4*pi*x)/sqrt(4*pi), 0)
3822# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3823
3824# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3825 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
3826# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3827 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
3828# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3829
3830# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3831 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
3832# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3833 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
3834# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3835 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
3836# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3837 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
3838# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3839 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
3840# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3841 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
3842# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3843 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
3844# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3845 ! Linear interpolation between r=0.08 and r=1.0
3846# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3847 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
3848# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3849 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
3850# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3851 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
3852# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3853 else
3854# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
3856# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
3858# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 end if
3860# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3861
3862# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3863 ! case 252 is for the 2D MHD Rotor problem
3864# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865 case (252) ! 2D MHD Rotor Problem
3866# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
3868# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869 !
3870# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 ! 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
3872# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 ! velocity w=20, giving v_tan=2 at r=0.1
3874# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875
3876# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 ! Calculate distance squared from the center
3878# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
3880# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881
3882# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 ! inner radius of 0.1
3884# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 if (r_sq <= 0.1**2) then
3886# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 ! -- Inside the rotor -- Set density uniformly to 10
3888# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
3890# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891
3892# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
3894# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
3896# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
3898# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899
3900# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901 ! taper width of 0.015
3902# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 else if (r_sq <= 0.115**2) then
3904# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905 ! linearly smooth the function between r = 0.1 and 0.115
3906# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3908# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909
3910# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3911 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3912# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3913 q_prim_vf(momxb + 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)
3914# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3915 end if
3916# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3917 case (253) ! MHD Smooth Magnetic Vortex
3918# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3919 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
3920# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3921 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
3922# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3923
3924# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3925 ! velocity
3926# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3927 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3928# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3929 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3930# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3931
3932# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3933 ! magnetic field
3934# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3935 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3936# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3937 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3938# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3939
3940# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3941 ! pressure
3942# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3943 q_prim_vf(e_idx)%sf(i, j, &
3944# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 & 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)
3946# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 case (260) ! Gaussian Divergence Pulse
3948# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
3950# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
3952# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 ! initialized to zero everywhere.
3954# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955
3956# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 eps_mhd = patch_icpp(patch_id)%a(2)
3958# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959 sigma = patch_icpp(patch_id)%a(3)
3960# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3962# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963
3964# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 ! B-field
3966# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3968# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969 case (261) ! Blob
3970# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 r0 = 1._wp/sqrt(8._wp)
3972# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973 r2 = x_cc(i)**2 + y_cc(j)**2
3974# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3975 r = sqrt(r2)
3976# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3977 alpha = r/r0
3978# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3979 if (alpha < 1) then
3980# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3981 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
3982# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
3984# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
3986# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
3988# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989 end if
3990# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
3992# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993 ! rotate by \alpha = atan(2)
3994# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 alpha = atan(2._wp)
3996# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 cosa = cos(alpha)
3998# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999 sina = sin(alpha)
4000# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001 ! projection along shock normal
4002# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003 r = x_cc(i)*cosa + y_cc(j)*sina
4004# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005
4006# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007 if (r <= 0.5_wp) then
4008# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4010# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4012# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
4014# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
4016# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
4018# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4020# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4022# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023 else
4024# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4026# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4028# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
4030# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
4032# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
4034# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4036# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4038# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039 end if
4040# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041 ! v^z and B^z remain zero by default
4042# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043 case (270) ! 2D extrusion of 1D profile from external data
4044# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4046# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047 if (.not. files_loaded) then
4048# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4050# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 do f = 1, max_files
4052# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053 write (file_num_str, '(I0)') f
4054# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
4056# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 end do
4058# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059
4060# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 ! Common file reading setup
4062# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4064# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
4066# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067
4068# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069 select case (num_dims)
4070# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071 case (1, 2) ! 1D and 2D cases are similar
4072# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073 ! Count lines
4074# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075 line_count = 0
4076# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077 do
4078# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4080# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081 if (ios2 /= 0) exit
4082# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083 line_count = line_count + 1
4084# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085 end do
4086# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087 close (unit2)
4088# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089
4090# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091 xrows = line_count
4092# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 yrows = 1
4094# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095 index_x = 0
4096# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 if (num_dims == 2) index_x = i
4098# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099#ifdef MFC_DEBUG
4100# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101 block
4102# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 use iso_fortran_env, only: output_unit
4104# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105
4106# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 print *, 'm_icpp_patches.fpp:377: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4108# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109
4110# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111 call flush (output_unit)
4112# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113 end block
4114# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115#endif
4116# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4118# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119
4120# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121
4122# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123
4124# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125#if defined(MFC_OpenACC)
4126# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127!$acc enter data create(x_coords, stored_values)
4128# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129#elif defined(MFC_OpenMP)
4130# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131!$omp target enter data map(always,alloc:x_coords, stored_values)
4132# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4133#endif
4134# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4135
4136# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4137 ! Read data from all files
4138# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4139 do f = 1, max_files
4140# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4141 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4142# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4143 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4144# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4145
4146# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4147 do iter = 1, xrows
4148# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4149 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4150# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4151 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
4152# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153 end do
4154# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 close (unit)
4156# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 end do
4158# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159
4160# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161 ! Calculate offsets
4162# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 domain_xstart = x_coords(1)
4164# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165 x_step = x_cc(1) - x_cc(0)
4166# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 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)
4168# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 global_offset_x = nint(abs(delta_x)/x_step)
4170# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 case (3) ! 3D case - determine grid structure
4172# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173 ! Find yRows by counting rows with same x
4174# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4176# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4178# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179
4180# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 yrows = 1
4182# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183 do
4184# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4186# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187 if (ios2 /= 0) exit
4188# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 if (dummy_x == x0 .and. dummy_y /= y0) then
4190# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 yrows = yrows + 1
4192# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 else
4194# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195 exit
4196# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 end if
4198# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 end do
4200# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 close (unit2)
4202# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203
4204# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205 ! Count total rows
4206# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4208# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209 nrows = 0
4210# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211 do
4212# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4214# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215 if (ios2 /= 0) exit
4216# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217 nrows = nrows + 1
4218# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 end do
4220# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221 close (unit2)
4222# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223
4224# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 xrows = nrows/yrows
4226# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227#ifdef MFC_DEBUG
4228# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 block
4230# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4231 use iso_fortran_env, only: output_unit
4232# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4233
4234# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235 print *, 'm_icpp_patches.fpp:377: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4236# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237
4238# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239 call flush (output_unit)
4240# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241 end block
4242# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243#endif
4244# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4246# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247
4248# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249
4250# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251
4252# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253
4254# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255#if defined(MFC_OpenACC)
4256# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257!$acc enter data create(x_coords, y_coords, stored_values)
4258# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259#elif defined(MFC_OpenMP)
4260# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4262# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263#endif
4264# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265 index_x = i
4266# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4267 index_y = j
4268# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269
4270# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 ! Read all files
4272# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273 do f = 1, max_files
4274# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4276# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277 if (ios /= 0) then
4278# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4280# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281 cycle
4282# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283 end if
4284# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285
4286# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287 iter = 0
4288# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289 do iix = 1, xrows
4290# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291 do iiy = 1, yrows
4292# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293 iter = iter + 1
4294# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 if (f == 1) then
4296# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4298# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 else
4300# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4302# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 end if
4304# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305 if (ios /= 0) call s_mpi_abort("Error reading data")
4306# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307 end do
4308# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 end do
4310# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311 close (unit)
4312# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313 end do
4314# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315
4316# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317 ! Calculate offsets
4318# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319 x_step = x_cc(1) - x_cc(0)
4320# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321 y_step = y_cc(1) - y_cc(0)
4322# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4324# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4326# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327 global_offset_x = nint(abs(delta_x)/x_step)
4328# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329 global_offset_y = nint(abs(delta_y)/y_step)
4330# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331 end select
4332# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333
4334# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335 files_loaded = .true.
4336# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337 end if
4338# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339
4340# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4341 ! Data assignment
4342# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4343 select case (num_dims)
4344# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4345 case (1)
4346# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4347 idx = i + 1 + global_offset_x
4348# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4349 do f = 1, sys_size
4350# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4351 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4352# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4353 end do
4354# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4355 case (2)
4356# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4357 idx = i + 1 + global_offset_x - index_x
4358# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4359 do f = 1, sys_size - 1
4360# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4361 jump = merge(1, 0, f >= momxe)
4362# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4363 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4364# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4365 end do
4366# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4367 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
4368# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4369 case (3)
4370# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4371 idx = i + 1 + global_offset_x - index_x
4372# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4373 idy = j + 1 + global_offset_y - index_y
4374# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4375 do f = 1, sys_size - 1
4376# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4377 jump = merge(1, 0, f >= momxe)
4378# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4379 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4380# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4381 end do
4382# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4383 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
4384# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4385 end select
4386# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4387 case (280) ! Isentropic vortex
4388# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4389 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
4390# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4391 ! geometry 2
4392# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4393 if (patch_id == 1) then
4394# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4395 q_prim_vf(e_idx)%sf(i, j, &
4396# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4397 & 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) &
4398# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4399 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
4400# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4401 q_prim_vf(contxb + 0)%sf(i, j, &
4402# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4403 & 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) &
4404# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4405 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
4406# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4407 q_prim_vf(momxb + 0)%sf(i, j, &
4408# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4409 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
4410# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4411 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4412# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4413 q_prim_vf(momxb + 1)%sf(i, j, &
4414# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4415 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
4416# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4417 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4418# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4419 end if
4420# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4421 case (281) ! Acoustic pulse
4422# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4423 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
4424# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4425 ! geometry 2
4426# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4427 if (patch_id == 2) then
4428# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4429 q_prim_vf(e_idx)%sf(i, j, &
4430# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4431 & 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))
4432# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4433 q_prim_vf(contxb + 0)%sf(i, j, &
4434# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4435 & 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))
4436# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4437 end if
4438# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4439 case (282) ! Zero-circulation vortex
4440# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4441 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
4442# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4443 ! geometry 2
4444# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4445 if (patch_id == 2) then
4446# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4447 q_prim_vf(e_idx)%sf(i, j, &
4448# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4449 & 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))
4450# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4451 q_prim_vf(contxb + 0)%sf(i, j, &
4452# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4453 & 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))
4454# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4455 q_prim_vf(momxb + 0)%sf(i, j, &
4456# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4457 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4458# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4459 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4460# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4461 end if
4462# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4463 case default
4464# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4465 if (proc_rank == 0) then
4466# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4467 call s_int_to_str(patch_id, istr)
4468# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4469 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
4470# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4471 end if
4472# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4473 end select
4474 end if
4475
4476 ! Updating the patch identities bookkeeping variable
4477 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
4478
4479 q_prim_vf(alf_idx)%sf(i, j, &
4480 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
4481 end if
4482 end do
4483 end do
4484 if (allocated(stored_values)) then
4485# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4486#ifdef MFC_DEBUG
4487# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4488 block
4489# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4490 use iso_fortran_env, only: output_unit
4491# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4492
4493# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4494 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(stored_values)'
4495# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4496
4497# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4498 call flush (output_unit)
4499# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4500 end block
4501# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4502#endif
4503# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4504
4505# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4506#if defined(MFC_OpenACC)
4507# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4508!$acc exit data delete(stored_values)
4509# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4510#elif defined(MFC_OpenMP)
4511# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4512!$omp target exit data map(release:stored_values)
4513# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4514#endif
4515# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4516 deallocate (stored_values)
4517# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4518#ifdef MFC_DEBUG
4519# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4520 block
4521# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4522 use iso_fortran_env, only: output_unit
4523# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4524
4525# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4526 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(x_coords)'
4527# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4528
4529# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4530 call flush (output_unit)
4531# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4532 end block
4533# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4534#endif
4535# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4536
4537# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4538#if defined(MFC_OpenACC)
4539# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4540!$acc exit data delete(x_coords)
4541# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4542#elif defined(MFC_OpenMP)
4543# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4544!$omp target exit data map(release:x_coords)
4545# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4546#endif
4547# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4548 deallocate (x_coords)
4549# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4550 end if
4551# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4552
4553# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4554 if (allocated(y_coords)) then
4555# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4556#ifdef MFC_DEBUG
4557# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4558 block
4559# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4560 use iso_fortran_env, only: output_unit
4561# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4562
4563# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4564 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(y_coords)'
4565# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4566
4567# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4568 call flush (output_unit)
4569# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4570 end block
4571# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4572#endif
4573# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4574
4575# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4576#if defined(MFC_OpenACC)
4577# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4578!$acc exit data delete(y_coords)
4579# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4580#elif defined(MFC_OpenMP)
4581# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4582!$omp target exit data map(release:y_coords)
4583# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4584#endif
4585# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4586 deallocate (y_coords)
4587# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4588 end if
4589
4590 end subroutine s_icpp_varcircle
4591
4592 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
4593 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
4594
4595 ! Patch identifier
4596 integer, intent(in) :: patch_id
4597
4598#ifdef MFC_MIXED_PRECISION
4599 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4600#else
4601 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4602#endif
4603 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
4604
4605 ! Generic loop iterators
4606 integer :: i, j, k
4607 real(wp) :: radius, myr, thickness
4608
4609 integer :: xRows, yRows, nRows, iix, iiy, max_files
4610# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4611 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
4612# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4613 real(wp) :: x_len, x_step, y_len, y_step
4614# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4615 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
4616# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4617 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
4618# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4619 real(wp) :: delta_x, delta_y
4620# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4621 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
4622# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4623 character(len=200) :: errmsg
4624# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4625 real(wp), allocatable :: stored_values(:,:,:)
4626# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4627 real(wp), allocatable :: x_coords(:), y_coords(:)
4628# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4629 logical :: files_loaded = .false.
4630# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4631 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
4632# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4633 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
4634# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4635 character(len=20) :: file_num_str !< For storing the file number as a string
4636# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4637 character(len=20) :: zeros_part !< For the trailing zeros part
4638# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4639 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
4640 ! Place any declaration of intermediate variables here
4641# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4642 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
4643# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4644 real(wp) :: eps
4645# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4646
4647# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4648 ! IGR Jets Arrays to stor position and radii of jets from input file
4649# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4650 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
4651# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4652 ! Variables to describe initial condition of jet
4653# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4654 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
4655# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4656 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
4657# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4658 real(wp), dimension(0:n,0:p) :: rcut_arr
4659# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4660 integer :: l, q, s !< Iterators for reading input files
4661# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4662 integer :: start, end !< Ints to keep track of position in file
4663# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4664 character(len=1000) :: line !< String to store line in file
4665# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4666 character(len=25) :: value !< String to store value in line
4667# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4668 integer :: NJet !< Number of jets
4669# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4670
4671# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4672 eps = 1e-9_wp
4673# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4674
4675# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4676 if (patch_icpp(patch_id)%hcid == 303) then
4677# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4678 eps_smooth = 3._wp
4679# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4680 open (unit=10, file="njet.txt", status="old", action="read")
4681# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4682 read (10, *) njet
4683# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4684 close (10)
4685# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4686
4687# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4688 allocate (y_th_arr(0:njet - 1))
4689# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4690 allocate (z_th_arr(0:njet - 1))
4691# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4692 allocate (r_th_arr(0:njet - 1))
4693# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4694
4695# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4696 open (unit=10, file="jets.csv", status="old", action="read")
4697# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4698 do q = 0, njet - 1
4699# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4700 read (10, '(A)') line ! Read a full line as a string
4701# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4702 start = 1
4703# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4704
4705# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4706 do l = 0, 2
4707# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4708 end = index(line(start:), ',') ! Find the next comma
4709# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4710 if (end == 0) then
4711# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4712 value = trim(adjustl(line(start:))) ! Last value in the line
4713# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4714 else
4715# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4716 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
4717# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4718 start = start + end ! Move to next value
4719# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4720 end if
4721# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4722 if (l == 0) then
4723# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4724 read (value, *) y_th_arr(q) ! Convert string to numeric value
4725# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4726 else if (l == 1) then
4727# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4728 read (value, *) z_th_arr(q)
4729# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4730 else
4731# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4732 read (value, *) r_th_arr(q)
4733# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4734 end if
4735# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4736 end do
4737# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4738 end do
4739# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4740 close (10)
4741# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4742
4743# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4744 do q = 0, p
4745# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4746 do l = 0, n
4747# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4748 rcut = 0._wp
4749# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4750 do s = 0, njet - 1
4751# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4752 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
4753# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4754 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
4755# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4756 end do
4757# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4758 rcut_arr(l, q) = rcut
4759# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4760 end do
4761# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4762 end do
4763# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4764 end if
4765
4766 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
4767 x_centroid = patch_icpp(patch_id)%x_centroid
4768 y_centroid = patch_icpp(patch_id)%y_centroid
4769 z_centroid = patch_icpp(patch_id)%z_centroid
4770 length_z = patch_icpp(patch_id)%length_z
4771 radius = patch_icpp(patch_id)%radius
4772 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
4773 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
4774 thickness = patch_icpp(patch_id)%epsilon
4775
4776 ! Initialize eta=1; modified if smoothing is enabled
4777 eta = 1._wp
4778
4779 ! write for all z
4780
4781 ! Assign patch vars if cell is covered and patch has write permission
4782 do k = 0, p
4783 do j = 0, n
4784 do i = 0, m
4785 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
4786
4787 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp .and. patch_icpp(patch_id) &
4788 & %alter_patch(patch_id_fp(i, j, k))) then
4789 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
4790
4791
4792 if (patch_icpp(patch_id)%hcid /= dflt_int) then
4793 select case (patch_icpp(patch_id)%hcid)
4794# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4795 case (300) ! Rayleigh-Taylor instability
4796# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4797 rhoh = 3._wp
4798# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4799 rhol = 1._wp
4800# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4801 pref = 1.e5_wp
4802# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4803 pint = pref
4804# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4805 h = 0.7_wp
4806# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4807 lam = 0.2_wp
4808# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4809 wl = 2._wp*pi/lam
4810# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4811 amp = 0.025_wp/wl
4812# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4813
4814# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4815 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
4816# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4817
4818# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4819 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4820# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4821
4822# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4823 if (alph < eps) alph = eps
4824# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4825 if (alph > 1._wp - eps) alph = 1._wp - eps
4826# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4827
4828# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4829 if (y_cc(j) > inth) then
4830# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4831 q_prim_vf(advxb)%sf(i, j, k) = alph
4832# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4833 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
4834# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4835 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
4836# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4837 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
4838# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4839 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4840# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4841 else
4842# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4843 q_prim_vf(advxb)%sf(i, j, k) = alph
4844# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4845 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
4846# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4847 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
4848# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4849 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
4850# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4851 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4852# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4853 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
4854# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4855 end if
4856# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4857 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
4858# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4859 h = 0.0_wp
4860# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4861 lam = 1.0_wp
4862# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4863 amp = patch_icpp(patch_id)%a(2)
4864# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4865 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
4866# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4867 if (x_cc(i) > inth) then
4868# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4869 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
4870# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4871 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
4872# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4873 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
4874# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4875 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
4876# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4877 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
4878# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4879 end if
4880# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4881 case (302) ! 3D Jet with IGR
4882# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4883 ux_th = 10*sqrt(1.4*0.4)
4884# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4885 ux_am = 0.0*sqrt(1.4)
4886# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4887 p_th = 2.0_wp
4888# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4889 p_am = 1.0_wp
4890# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4891 rho_th = 1._wp
4892# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4893 rho_am = 1._wp
4894# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4895 y_th = 0.0_wp
4896# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4897 z_th = 0.0_wp
4898# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4899 r_th = 1._wp
4900# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4901 eps_smooth = 1._wp
4902# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4903 eps = 1e-6
4904# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4905
4906# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4907 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
4908# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4909 rcut = f_cut_on(r - r_th, eps_smooth)
4910# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4911 xcut = f_cut_on(x_cc(i), eps_smooth)
4912# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4913
4914# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4915 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
4916# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4917 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
4918# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4919 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
4920# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4921
4922# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4923 if (num_fluids == 1) then
4924# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4925 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
4926# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4927 else
4928# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4929 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
4930# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4931 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
4932# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4933 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
4934# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4935 end if
4936# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4937
4938# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4939 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
4940# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4941 case (303) ! 3D Multijet
4942# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4943 eps_smooth = 3.0_wp
4944# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4945 ux_th = 10*sqrt(1.4*0.4)
4946# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4947 ux_am = 2.5*sqrt(1.4*0.4)
4948# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4949 p_th = 0.8_wp
4950# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4951 p_am = 0.4_wp
4952# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4953 rho_th = 1._wp
4954# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4955 rho_am = 1._wp
4956# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4957 eps = 1e-6
4958# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4959
4960# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4961 rcut = rcut_arr(j, k)
4962# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4963 xcut = f_cut_on(x_cc(i), eps_smooth)
4964# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4965
4966# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4967 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
4968# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4969 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
4970# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4971 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
4972# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4973
4974# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4975 if (num_fluids == 1) then
4976# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4977 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
4978# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4979 else
4980# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4981 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
4982# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4983 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
4984# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4985 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
4986# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4987 end if
4988# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4989
4990# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4991 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
4992# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4993 case (370) ! 3D extrusion of 2D profile from external data
4994# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4995 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
4996# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4997 if (.not. files_loaded) then
4998# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4999 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5000# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5001 do f = 1, max_files
5002# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5003 write (file_num_str, '(I0)') f
5004# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5005 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
5006# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5007 end do
5008# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5009
5010# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5011 ! Common file reading setup
5012# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5013 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5014# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5015 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5016# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5017
5018# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5019 select case (num_dims)
5020# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5021 case (1, 2) ! 1D and 2D cases are similar
5022# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5023 ! Count lines
5024# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5025 line_count = 0
5026# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5027 do
5028# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5029 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5030# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5031 if (ios2 /= 0) exit
5032# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5033 line_count = line_count + 1
5034# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5035 end do
5036# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5037 close (unit2)
5038# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5039
5040# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5041 xrows = line_count
5042# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5043 yrows = 1
5044# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5045 index_x = 0
5046# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5047 if (num_dims == 2) index_x = i
5048# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5049#ifdef MFC_DEBUG
5050# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5051 block
5052# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5053 use iso_fortran_env, only: output_unit
5054# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5055
5056# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5057 print *, 'm_icpp_patches.fpp:439: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5058# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5059
5060# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5061 call flush (output_unit)
5062# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5063 end block
5064# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5065#endif
5066# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5067 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5068# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5069
5070# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5071
5072# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5073
5074# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5075#if defined(MFC_OpenACC)
5076# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5077!$acc enter data create(x_coords, stored_values)
5078# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5079#elif defined(MFC_OpenMP)
5080# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5081!$omp target enter data map(always,alloc:x_coords, stored_values)
5082# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5083#endif
5084# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5085
5086# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5087 ! Read data from all files
5088# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5089 do f = 1, max_files
5090# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5091 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5092# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5093 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5094# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5095
5096# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5097 do iter = 1, xrows
5098# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5099 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5100# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5101 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5102# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5103 end do
5104# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5105 close (unit)
5106# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5107 end do
5108# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5109
5110# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5111 ! Calculate offsets
5112# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5113 domain_xstart = x_coords(1)
5114# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5115 x_step = x_cc(1) - x_cc(0)
5116# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5117 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)
5118# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5119 global_offset_x = nint(abs(delta_x)/x_step)
5120# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5121 case (3) ! 3D case - determine grid structure
5122# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5123 ! Find yRows by counting rows with same x
5124# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5125 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5126# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5127 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5128# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5129
5130# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5131 yrows = 1
5132# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5133 do
5134# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5135 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5136# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5137 if (ios2 /= 0) exit
5138# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5139 if (dummy_x == x0 .and. dummy_y /= y0) then
5140# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5141 yrows = yrows + 1
5142# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5143 else
5144# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5145 exit
5146# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5147 end if
5148# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5149 end do
5150# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5151 close (unit2)
5152# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5153
5154# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5155 ! Count total rows
5156# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5157 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5158# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5159 nrows = 0
5160# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5161 do
5162# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5163 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5164# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5165 if (ios2 /= 0) exit
5166# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5167 nrows = nrows + 1
5168# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5169 end do
5170# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5171 close (unit2)
5172# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5173
5174# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5175 xrows = nrows/yrows
5176# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5177#ifdef MFC_DEBUG
5178# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5179 block
5180# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5181 use iso_fortran_env, only: output_unit
5182# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5183
5184# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5185 print *, 'm_icpp_patches.fpp:439: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5186# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5187
5188# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5189 call flush (output_unit)
5190# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5191 end block
5192# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5193#endif
5194# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5195 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5196# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5197
5198# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5199
5200# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5201
5202# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5203
5204# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5205#if defined(MFC_OpenACC)
5206# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5207!$acc enter data create(x_coords, y_coords, stored_values)
5208# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5209#elif defined(MFC_OpenMP)
5210# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5211!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5212# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5213#endif
5214# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5215 index_x = i
5216# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5217 index_y = j
5218# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5219
5220# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5221 ! Read all files
5222# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5223 do f = 1, max_files
5224# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5225 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5226# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5227 if (ios /= 0) then
5228# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5229 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5230# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5231 cycle
5232# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5233 end if
5234# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5235
5236# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5237 iter = 0
5238# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5239 do iix = 1, xrows
5240# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5241 do iiy = 1, yrows
5242# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5243 iter = iter + 1
5244# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5245 if (f == 1) then
5246# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5247 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5248# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5249 else
5250# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5251 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5252# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5253 end if
5254# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5255 if (ios /= 0) call s_mpi_abort("Error reading data")
5256# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5257 end do
5258# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5259 end do
5260# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5261 close (unit)
5262# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5263 end do
5264# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5265
5266# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5267 ! Calculate offsets
5268# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5269 x_step = x_cc(1) - x_cc(0)
5270# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5271 y_step = y_cc(1) - y_cc(0)
5272# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5273 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5274# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5275 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5276# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5277 global_offset_x = nint(abs(delta_x)/x_step)
5278# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5279 global_offset_y = nint(abs(delta_y)/y_step)
5280# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5281 end select
5282# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5283
5284# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5285 files_loaded = .true.
5286# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5287 end if
5288# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5289
5290# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5291 ! Data assignment
5292# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5293 select case (num_dims)
5294# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5295 case (1)
5296# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5297 idx = i + 1 + global_offset_x
5298# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5299 do f = 1, sys_size
5300# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5301 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5302# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5303 end do
5304# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5305 case (2)
5306# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5307 idx = i + 1 + global_offset_x - index_x
5308# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5309 do f = 1, sys_size - 1
5310# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5311 jump = merge(1, 0, f >= momxe)
5312# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5313 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5314# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5315 end do
5316# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5317 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
5318# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5319 case (3)
5320# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5321 idx = i + 1 + global_offset_x - index_x
5322# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5323 idy = j + 1 + global_offset_y - index_y
5324# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5325 do f = 1, sys_size - 1
5326# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5327 jump = merge(1, 0, f >= momxe)
5328# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5329 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5330# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5331 end do
5332# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5333 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
5334# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5335 end select
5336# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5337 case (380) ! Taylor-Green vortex
5338# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5339 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
5340# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5341 ! geometry 9
5342# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5343 mach = 0.1
5344# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5345 if (patch_id == 1) then
5346# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5347 q_prim_vf(e_idx)%sf(i, j, &
5348# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5349 & 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)
5350# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5351 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
5352# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5353 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
5354# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5355 end if
5356# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5357 case default
5358# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5359 call s_int_to_str(patch_id, istr)
5360# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5361 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
5362# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5363 end select
5364 end if
5365
5366 ! Updating the patch identities bookkeeping variable
5367 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5368
5369 q_prim_vf(alf_idx)%sf(i, j, &
5370 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5371 end if
5372 end do
5373 end do
5374 end do
5375 if (allocated(stored_values)) then
5376# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5377#ifdef MFC_DEBUG
5378# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5379 block
5380# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5381 use iso_fortran_env, only: output_unit
5382# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5383
5384# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5385 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(stored_values)'
5386# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5387
5388# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5389 call flush (output_unit)
5390# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5391 end block
5392# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5393#endif
5394# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5395
5396# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5397#if defined(MFC_OpenACC)
5398# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5399!$acc exit data delete(stored_values)
5400# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5401#elif defined(MFC_OpenMP)
5402# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5403!$omp target exit data map(release:stored_values)
5404# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5405#endif
5406# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5407 deallocate (stored_values)
5408# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5409#ifdef MFC_DEBUG
5410# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5411 block
5412# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5413 use iso_fortran_env, only: output_unit
5414# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5415
5416# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5417 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(x_coords)'
5418# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5419
5420# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5421 call flush (output_unit)
5422# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5423 end block
5424# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5425#endif
5426# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5427
5428# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5429#if defined(MFC_OpenACC)
5430# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5431!$acc exit data delete(x_coords)
5432# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5433#elif defined(MFC_OpenMP)
5434# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5435!$omp target exit data map(release:x_coords)
5436# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5437#endif
5438# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5439 deallocate (x_coords)
5440# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5441 end if
5442# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5443
5444# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5445 if (allocated(y_coords)) then
5446# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5447#ifdef MFC_DEBUG
5448# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5449 block
5450# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5451 use iso_fortran_env, only: output_unit
5452# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5453
5454# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5455 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(y_coords)'
5456# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5457
5458# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5459 call flush (output_unit)
5460# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5461 end block
5462# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5463#endif
5464# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5465
5466# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5467#if defined(MFC_OpenACC)
5468# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5469!$acc exit data delete(y_coords)
5470# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5471#elif defined(MFC_OpenMP)
5472# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5473!$omp target exit data map(release:y_coords)
5474# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5475#endif
5476# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5477 deallocate (y_coords)
5478# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5479 end if
5480
5481 end subroutine s_icpp_3dvarcircle
5482
5483 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
5484 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
5485 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
5486
5487 integer, intent(in) :: patch_id
5488
5489#ifdef MFC_MIXED_PRECISION
5490 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5491#else
5492 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5493#endif
5494 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5495 integer :: i, j, k !< Generic loop operators
5496 real(wp) :: a, b
5497
5498 integer :: xRows, yRows, nRows, iix, iiy, max_files
5499# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5500 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5501# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5502 real(wp) :: x_len, x_step, y_len, y_step
5503# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5504 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5505# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5506 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
5507# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5508 real(wp) :: delta_x, delta_y
5509# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5510 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
5511# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5512 character(len=200) :: errmsg
5513# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5514 real(wp), allocatable :: stored_values(:,:,:)
5515# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5516 real(wp), allocatable :: x_coords(:), y_coords(:)
5517# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5518 logical :: files_loaded = .false.
5519# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5520 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5521# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5522 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
5523# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5524 character(len=20) :: file_num_str !< For storing the file number as a string
5525# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5526 character(len=20) :: zeros_part !< For the trailing zeros part
5527# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5528 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
5529 ! Place any declaration of intermediate variables here
5530# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5531 real(wp) :: eps, eps_mhd, C_mhd
5532# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5533 real(wp) :: r, rmax, gam, umax, p0
5534# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5535 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
5536# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5537 real(wp) :: factor
5538# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5539 real(wp) :: r0, alpha, r2
5540# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5541 real(wp) :: sinA, cosA
5542# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5543 real(wp) :: r_sq
5544# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5545
5546# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5547 ! # 207
5548# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5549 real(wp) :: sigma, gauss1, gauss2
5550# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5551 ! # 208
5552# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5553 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
5554# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5555
5556# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5557 eps = 1.e-9_wp
5558
5559 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
5560 x_centroid = patch_icpp(patch_id)%x_centroid
5561 y_centroid = patch_icpp(patch_id)%y_centroid
5562 a = patch_icpp(patch_id)%radii(1)
5563 b = patch_icpp(patch_id)%radii(2)
5564 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5565 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5566
5567 ! Initialize eta=1; modified if smoothing is enabled
5568 eta = 1._wp
5569
5570 ! Assign patch vars if cell is covered and patch has write permission
5571 do j = 0, n
5572 do i = 0, m
5573 if (patch_icpp(patch_id)%smoothen) then
5574 eta = tanh(smooth_coeff/min(dx, &
5575 & dy)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
5576 & + 0.5_wp
5577 end if
5578
5579 if ((((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp .and. patch_icpp(patch_id) &
5580 & %alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
5581 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
5582
5583
5584 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5585 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
5586# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5587 case (200) ! Two-fluid cubic interface
5588# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5589 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
5590# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5591 ! Volume Fractions
5592# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5593 q_prim_vf(advxb)%sf(i, j, 0) = eps
5594# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5595 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
5596# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5597 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
5598# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5599 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
5600# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5601 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
5602# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5603 end if
5604# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5605 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
5606# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5607 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
5608# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5609 rmax = 0.2_wp
5610# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5611
5612# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5613 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
5614# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5615 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
5616# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5617 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
5618# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5619
5620# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5621 if (r < rmax) then
5622# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5623 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
5624# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5625 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
5626# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5627 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
5628# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5629 else if (r < 2*rmax) then
5630# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5631 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
5632# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5633 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
5634# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5635 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
5636# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5637 else
5638# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5639 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
5640# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5641 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
5642# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5643 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
5644# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5645 end if
5646# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5647 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
5648# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5649 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
5650# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5651 rmax = 0.2_wp
5652# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5653
5654# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5655 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
5656# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5657 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
5658# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5659 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
5660# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5661
5662# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5663 if (r < rmax) then
5664# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5665 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
5666# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5667 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
5668# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5669 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
5670# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5671 else if (r < 2*rmax) then
5672# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5673 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
5674# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5675 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
5676# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5677 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
5678# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5679 else
5680# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5681 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
5682# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5683 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
5684# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5685 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
5686# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5687 end if
5688# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5689
5690# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5691 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
5692# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5693 case (204) ! Rayleigh-Taylor instability
5694# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5695 rhoh = 3._wp
5696# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5697 rhol = 1._wp
5698# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5699 pref = 1.e5_wp
5700# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5701 pint = pref
5702# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5703 h = 0.7_wp
5704# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5705 lam = 0.2_wp
5706# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5707 wl = 2._wp*pi/lam
5708# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5709 amp = 0.05_wp/wl
5710# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5711
5712# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5713 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
5714# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5715
5716# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5717 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5718# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5719
5720# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5721 if (alph < eps) alph = eps
5722# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5723 if (alph > 1._wp - eps) alph = 1._wp - eps
5724# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5725
5726# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5727 if (y_cc(j) > inth) then
5728# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5729 q_prim_vf(advxb)%sf(i, j, 0) = alph
5730# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5731 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
5732# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5733 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
5734# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5735 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
5736# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5737 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5738# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5739 else
5740# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5741 q_prim_vf(advxb)%sf(i, j, 0) = alph
5742# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5743 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
5744# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5745 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
5746# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5747 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
5748# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5749 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5750# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5751 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
5752# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5753 end if
5754# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5755 case (205) ! 2D lung wave interaction problem
5756# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5757 h = 0.0_wp ! non dim origin y
5758# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5759 lam = 1.0_wp ! non dim lambda
5760# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5761 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
5762# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5763
5764# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5765 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
5766# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5767
5768# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5769 if (y_cc(j) > inth) then
5770# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5771 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
5772# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5773 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
5774# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5775 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
5776# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5777 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
5778# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5779 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
5780# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5781 end if
5782# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5783 case (206) ! 2D lung wave interaction problem - horizontal domain
5784# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5785 h = 0.0_wp ! non dim origin y
5786# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5787 lam = 1.0_wp ! non dim lambda
5788# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5789 amp = patch_icpp(patch_id)%a(2)
5790# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5791
5792# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5793 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
5794# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5795
5796# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5797 if (x_cc(i) > intl) then ! this is the liquid
5798# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5799 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
5800# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5801 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
5802# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5803 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
5804# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5805 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
5806# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5807 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
5808# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5809 end if
5810# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5811 case (207) ! Kelvin Helmholtz Instability
5812# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5813 sigma = 0.05_wp/sqrt(2.0_wp)
5814# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5815 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
5816# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5817 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
5818# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5819 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
5820# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5821 case (208) ! Richtmeyer Meshkov Instability
5822# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5823 lam = 1.0_wp
5824# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5825 eps = 1.0e-6_wp
5826# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5827 ei = 5.0_wp
5828# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5829 ! Smoothening function to smooth out sharp discontinuity in the interface
5830# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5831 if (x_cc(i) <= 0.7_wp*lam) then
5832# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5833 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
5834# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5835 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
5836# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5837 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
5838# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5839 alpha_sf6 = 1.0_wp - alpha_air
5840# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5841 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
5842# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5843 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
5844# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5845 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
5846# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5847 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
5848# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5849 end if
5850# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5851 case (250) ! MHD Orszag-Tang vortex
5852# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5853 ! 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),
5854# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5855 ! sin(4*pi*x)/sqrt(4*pi), 0)
5856# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5857
5858# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5859 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
5860# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5861 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
5862# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5863
5864# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5865 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
5866# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5867 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
5868# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5869 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
5870# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5871 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
5872# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5873 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
5874# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5875 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
5876# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5877 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
5878# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5879 ! Linear interpolation between r=0.08 and r=1.0
5880# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5881 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
5882# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5883 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
5884# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5885 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
5886# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5887 else
5888# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5889 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
5890# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5891 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
5892# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5893 end if
5894# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5895
5896# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5897 ! case 252 is for the 2D MHD Rotor problem
5898# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5899 case (252) ! 2D MHD Rotor Problem
5900# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5901 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
5902# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5903 !
5904# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5905 ! 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
5906# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5907 ! velocity w=20, giving v_tan=2 at r=0.1
5908# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5909
5910# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5911 ! Calculate distance squared from the center
5912# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5913 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
5914# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5915
5916# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5917 ! inner radius of 0.1
5918# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5919 if (r_sq <= 0.1**2) then
5920# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5921 ! -- Inside the rotor -- Set density uniformly to 10
5922# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5923 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
5924# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5925
5926# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5927 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
5928# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5929 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
5930# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5931 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
5932# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5933
5934# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5935 ! taper width of 0.015
5936# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5937 else if (r_sq <= 0.115**2) then
5938# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5939 ! linearly smooth the function between r = 0.1 and 0.115
5940# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5941 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
5942# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5943
5944# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5945 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
5946# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5947 q_prim_vf(momxb + 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)
5948# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5949 end if
5950# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5951 case (253) ! MHD Smooth Magnetic Vortex
5952# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5953 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
5954# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5955 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
5956# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5957
5958# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5959 ! velocity
5960# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5961 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
5962# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5963 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
5964# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5965
5966# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5967 ! magnetic field
5968# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5969 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
5970# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5971 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
5972# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5973
5974# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5975 ! pressure
5976# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5977 q_prim_vf(e_idx)%sf(i, j, &
5978# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5979 & 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)
5980# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5981 case (260) ! Gaussian Divergence Pulse
5982# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5983 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
5984# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5985 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
5986# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5987 ! initialized to zero everywhere.
5988# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5989
5990# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5991 eps_mhd = patch_icpp(patch_id)%a(2)
5992# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5993 sigma = patch_icpp(patch_id)%a(3)
5994# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5995 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
5996# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5997
5998# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5999 ! B-field
6000# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6001 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6002# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6003 case (261) ! Blob
6004# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6005 r0 = 1._wp/sqrt(8._wp)
6006# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6007 r2 = x_cc(i)**2 + y_cc(j)**2
6008# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6009 r = sqrt(r2)
6010# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6011 alpha = r/r0
6012# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6013 if (alpha < 1) then
6014# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6015 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
6016# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6017 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
6018# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6019 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
6020# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6021 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
6022# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6023 end if
6024# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6025 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
6026# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6027 ! rotate by \alpha = atan(2)
6028# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6029 alpha = atan(2._wp)
6030# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6031 cosa = cos(alpha)
6032# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6033 sina = sin(alpha)
6034# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6035 ! projection along shock normal
6036# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6037 r = x_cc(i)*cosa + y_cc(j)*sina
6038# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6039
6040# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6041 if (r <= 0.5_wp) then
6042# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6043 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
6044# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6045 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6046# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6047 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
6048# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6049 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
6050# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6051 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
6052# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6053 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6054# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6055 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6056# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6057 else
6058# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6059 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
6060# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6061 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6062# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6063 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
6064# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6065 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
6066# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6067 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
6068# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6069 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6070# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6071 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6072# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6073 end if
6074# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6075 ! v^z and B^z remain zero by default
6076# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6077 case (270) ! 2D extrusion of 1D profile from external data
6078# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6079 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6080# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6081 if (.not. files_loaded) then
6082# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6083 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6084# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6085 do f = 1, max_files
6086# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6087 write (file_num_str, '(I0)') f
6088# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6089 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
6090# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6091 end do
6092# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6093
6094# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6095 ! Common file reading setup
6096# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6097 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6098# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6099 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6100# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6101
6102# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6103 select case (num_dims)
6104# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6105 case (1, 2) ! 1D and 2D cases are similar
6106# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6107 ! Count lines
6108# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6109 line_count = 0
6110# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6111 do
6112# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6113 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6114# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6115 if (ios2 /= 0) exit
6116# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6117 line_count = line_count + 1
6118# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6119 end do
6120# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6121 close (unit2)
6122# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6123
6124# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6125 xrows = line_count
6126# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6127 yrows = 1
6128# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6129 index_x = 0
6130# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6131 if (num_dims == 2) index_x = i
6132# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6133#ifdef MFC_DEBUG
6134# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6135 block
6136# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6137 use iso_fortran_env, only: output_unit
6138# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6139
6140# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6141 print *, 'm_icpp_patches.fpp:499: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6142# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6143
6144# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6145 call flush (output_unit)
6146# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6147 end block
6148# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6149#endif
6150# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6151 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6152# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6153
6154# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6155
6156# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6157
6158# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6159#if defined(MFC_OpenACC)
6160# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6161!$acc enter data create(x_coords, stored_values)
6162# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6163#elif defined(MFC_OpenMP)
6164# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6165!$omp target enter data map(always,alloc:x_coords, stored_values)
6166# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6167#endif
6168# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6169
6170# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6171 ! Read data from all files
6172# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6173 do f = 1, max_files
6174# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6175 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6176# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6177 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6178# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6179
6180# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6181 do iter = 1, xrows
6182# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6183 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6184# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6185 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6186# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6187 end do
6188# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6189 close (unit)
6190# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6191 end do
6192# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6193
6194# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6195 ! Calculate offsets
6196# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6197 domain_xstart = x_coords(1)
6198# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6199 x_step = x_cc(1) - x_cc(0)
6200# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6201 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)
6202# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6203 global_offset_x = nint(abs(delta_x)/x_step)
6204# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6205 case (3) ! 3D case - determine grid structure
6206# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6207 ! Find yRows by counting rows with same x
6208# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6209 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6210# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6211 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6212# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6213
6214# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6215 yrows = 1
6216# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6217 do
6218# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6219 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6220# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6221 if (ios2 /= 0) exit
6222# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6223 if (dummy_x == x0 .and. dummy_y /= y0) then
6224# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6225 yrows = yrows + 1
6226# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6227 else
6228# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6229 exit
6230# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6231 end if
6232# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6233 end do
6234# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6235 close (unit2)
6236# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6237
6238# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6239 ! Count total rows
6240# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6241 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6242# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6243 nrows = 0
6244# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6245 do
6246# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6247 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6248# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6249 if (ios2 /= 0) exit
6250# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6251 nrows = nrows + 1
6252# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6253 end do
6254# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6255 close (unit2)
6256# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6257
6258# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6259 xrows = nrows/yrows
6260# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6261#ifdef MFC_DEBUG
6262# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6263 block
6264# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6265 use iso_fortran_env, only: output_unit
6266# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6267
6268# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6269 print *, 'm_icpp_patches.fpp:499: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6270# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6271
6272# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6273 call flush (output_unit)
6274# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6275 end block
6276# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6277#endif
6278# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6279 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6280# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6281
6282# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6283
6284# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6285
6286# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6287
6288# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6289#if defined(MFC_OpenACC)
6290# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6291!$acc enter data create(x_coords, y_coords, stored_values)
6292# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6293#elif defined(MFC_OpenMP)
6294# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6295!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6296# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6297#endif
6298# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6299 index_x = i
6300# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6301 index_y = j
6302# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6303
6304# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6305 ! Read all files
6306# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6307 do f = 1, max_files
6308# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6309 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6310# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6311 if (ios /= 0) then
6312# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6313 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6314# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6315 cycle
6316# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6317 end if
6318# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6319
6320# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6321 iter = 0
6322# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6323 do iix = 1, xrows
6324# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6325 do iiy = 1, yrows
6326# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6327 iter = iter + 1
6328# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6329 if (f == 1) then
6330# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6331 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6332# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6333 else
6334# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6335 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6336# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6337 end if
6338# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6339 if (ios /= 0) call s_mpi_abort("Error reading data")
6340# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6341 end do
6342# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6343 end do
6344# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6345 close (unit)
6346# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6347 end do
6348# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6349
6350# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6351 ! Calculate offsets
6352# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6353 x_step = x_cc(1) - x_cc(0)
6354# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6355 y_step = y_cc(1) - y_cc(0)
6356# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6357 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6358# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6359 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6360# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6361 global_offset_x = nint(abs(delta_x)/x_step)
6362# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6363 global_offset_y = nint(abs(delta_y)/y_step)
6364# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6365 end select
6366# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6367
6368# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6369 files_loaded = .true.
6370# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6371 end if
6372# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6373
6374# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6375 ! Data assignment
6376# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6377 select case (num_dims)
6378# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6379 case (1)
6380# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6381 idx = i + 1 + global_offset_x
6382# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6383 do f = 1, sys_size
6384# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6385 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6386# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6387 end do
6388# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6389 case (2)
6390# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6391 idx = i + 1 + global_offset_x - index_x
6392# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6393 do f = 1, sys_size - 1
6394# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6395 jump = merge(1, 0, f >= momxe)
6396# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6397 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6398# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6399 end do
6400# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6401 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
6402# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6403 case (3)
6404# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6405 idx = i + 1 + global_offset_x - index_x
6406# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6407 idy = j + 1 + global_offset_y - index_y
6408# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6409 do f = 1, sys_size - 1
6410# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6411 jump = merge(1, 0, f >= momxe)
6412# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6413 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6414# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6415 end do
6416# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6417 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
6418# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6419 end select
6420# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6421 case (280) ! Isentropic vortex
6422# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6423 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6424# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6425 ! geometry 2
6426# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6427 if (patch_id == 1) then
6428# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6429 q_prim_vf(e_idx)%sf(i, j, &
6430# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6431 & 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) &
6432# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6433 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6434# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6435 q_prim_vf(contxb + 0)%sf(i, j, &
6436# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6437 & 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) &
6438# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6439 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6440# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6441 q_prim_vf(momxb + 0)%sf(i, j, &
6442# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6443 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
6444# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6445 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6446# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6447 q_prim_vf(momxb + 1)%sf(i, j, &
6448# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6449 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
6450# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6451 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6452# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6453 end if
6454# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6455 case (281) ! Acoustic pulse
6456# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6457 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
6458# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6459 ! geometry 2
6460# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6461 if (patch_id == 2) then
6462# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6463 q_prim_vf(e_idx)%sf(i, j, &
6464# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6465 & 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))
6466# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6467 q_prim_vf(contxb + 0)%sf(i, j, &
6468# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6469 & 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))
6470# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6471 end if
6472# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6473 case (282) ! Zero-circulation vortex
6474# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6475 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
6476# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6477 ! geometry 2
6478# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6479 if (patch_id == 2) then
6480# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6481 q_prim_vf(e_idx)%sf(i, j, &
6482# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6483 & 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))
6484# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6485 q_prim_vf(contxb + 0)%sf(i, j, &
6486# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6487 & 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))
6488# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6489 q_prim_vf(momxb + 0)%sf(i, j, &
6490# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6491 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6492# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6493 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6494# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6495 end if
6496# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6497 case default
6498# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6499 if (proc_rank == 0) then
6500# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6501 call s_int_to_str(patch_id, istr)
6502# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6503 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
6504# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6505 end if
6506# 499 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6507 end select
6508 end if
6509
6510 ! Updating the patch identities bookkeeping variable
6511 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
6512 end if
6513 end do
6514 end do
6515 if (allocated(stored_values)) then
6516# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6517#ifdef MFC_DEBUG
6518# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6519 block
6520# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6521 use iso_fortran_env, only: output_unit
6522# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6523
6524# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6525 print *, 'm_icpp_patches.fpp:507: ', '@:DEALLOCATE(stored_values)'
6526# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6527
6528# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6529 call flush (output_unit)
6530# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6531 end block
6532# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6533#endif
6534# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6535
6536# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6537#if defined(MFC_OpenACC)
6538# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6539!$acc exit data delete(stored_values)
6540# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6541#elif defined(MFC_OpenMP)
6542# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6543!$omp target exit data map(release:stored_values)
6544# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6545#endif
6546# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6547 deallocate (stored_values)
6548# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6549#ifdef MFC_DEBUG
6550# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6551 block
6552# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6553 use iso_fortran_env, only: output_unit
6554# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6555
6556# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6557 print *, 'm_icpp_patches.fpp:507: ', '@:DEALLOCATE(x_coords)'
6558# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6559
6560# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6561 call flush (output_unit)
6562# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6563 end block
6564# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6565#endif
6566# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6567
6568# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6569#if defined(MFC_OpenACC)
6570# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6571!$acc exit data delete(x_coords)
6572# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6573#elif defined(MFC_OpenMP)
6574# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6575!$omp target exit data map(release:x_coords)
6576# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6577#endif
6578# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6579 deallocate (x_coords)
6580# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6581 end if
6582# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6583
6584# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6585 if (allocated(y_coords)) then
6586# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6587#ifdef MFC_DEBUG
6588# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6589 block
6590# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6591 use iso_fortran_env, only: output_unit
6592# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6593
6594# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6595 print *, 'm_icpp_patches.fpp:507: ', '@:DEALLOCATE(y_coords)'
6596# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6597
6598# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6599 call flush (output_unit)
6600# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6601 end block
6602# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6603#endif
6604# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6605
6606# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6607#if defined(MFC_OpenACC)
6608# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6609!$acc exit data delete(y_coords)
6610# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6611#elif defined(MFC_OpenMP)
6612# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6613!$omp target exit data map(release:y_coords)
6614# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6615#endif
6616# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6617 deallocate (y_coords)
6618# 507 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6619 end if
6620
6621 end subroutine s_icpp_ellipse
6622
6623 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
6624 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
6625 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
6626
6627 ! Patch identifier
6628 integer, intent(in) :: patch_id
6629
6630#ifdef MFC_MIXED_PRECISION
6631 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6632#else
6633 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6634#endif
6635 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
6636
6637 ! Generic loop iterators
6638 integer :: i, j, k
6639 real(wp) :: a, b, c
6640
6641 integer :: xRows, yRows, nRows, iix, iiy, max_files
6642# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6643 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
6644# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6645 real(wp) :: x_len, x_step, y_len, y_step
6646# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6647 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
6648# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6649 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
6650# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6651 real(wp) :: delta_x, delta_y
6652# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6653 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
6654# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6655 character(len=200) :: errmsg
6656# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6657 real(wp), allocatable :: stored_values(:,:,:)
6658# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6659 real(wp), allocatable :: x_coords(:), y_coords(:)
6660# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6661 logical :: files_loaded = .false.
6662# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6663 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
6664# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6665 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
6666# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6667 character(len=20) :: file_num_str !< For storing the file number as a string
6668# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6669 character(len=20) :: zeros_part !< For the trailing zeros part
6670# 529 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6671 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
6672 ! Place any declaration of intermediate variables here
6673# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
6675# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 real(wp) :: eps
6677# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678
6679# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 ! IGR Jets Arrays to stor position and radii of jets from input file
6681# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
6683# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 ! Variables to describe initial condition of jet
6685# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
6687# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
6689# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 real(wp), dimension(0:n,0:p) :: rcut_arr
6691# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 integer :: l, q, s !< Iterators for reading input files
6693# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694 integer :: start, end !< Ints to keep track of position in file
6695# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696 character(len=1000) :: line !< String to store line in file
6697# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698 character(len=25) :: value !< String to store value in line
6699# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700 integer :: NJet !< Number of jets
6701# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702
6703# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704 eps = 1e-9_wp
6705# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706
6707# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708 if (patch_icpp(patch_id)%hcid == 303) then
6709# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710 eps_smooth = 3._wp
6711# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712 open (unit=10, file="njet.txt", status="old", action="read")
6713# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714 read (10, *) njet
6715# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716 close (10)
6717# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718
6719# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720 allocate (y_th_arr(0:njet - 1))
6721# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722 allocate (z_th_arr(0:njet - 1))
6723# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724 allocate (r_th_arr(0:njet - 1))
6725# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726
6727# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728 open (unit=10, file="jets.csv", status="old", action="read")
6729# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730 do q = 0, njet - 1
6731# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732 read (10, '(A)') line ! Read a full line as a string
6733# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734 start = 1
6735# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736
6737# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738 do l = 0, 2
6739# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 end = index(line(start:), ',') ! Find the next comma
6741# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 if (end == 0) then
6743# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 value = trim(adjustl(line(start:))) ! Last value in the line
6745# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 else
6747# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
6749# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 start = start + end ! Move to next value
6751# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 end if
6753# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 if (l == 0) then
6755# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 read (value, *) y_th_arr(q) ! Convert string to numeric value
6757# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758 else if (l == 1) then
6759# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 read (value, *) z_th_arr(q)
6761# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 else
6763# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 read (value, *) r_th_arr(q)
6765# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 end if
6767# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768 end do
6769# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 end do
6771# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 close (10)
6773# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774
6775# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 do q = 0, p
6777# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 do l = 0, n
6779# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 rcut = 0._wp
6781# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 do s = 0, njet - 1
6783# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
6785# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
6787# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 end do
6789# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 rcut_arr(l, q) = rcut
6791# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 end do
6793# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 end do
6795# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 end if
6797
6798 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
6799 x_centroid = patch_icpp(patch_id)%x_centroid
6800 y_centroid = patch_icpp(patch_id)%y_centroid
6801 z_centroid = patch_icpp(patch_id)%z_centroid
6802 a = patch_icpp(patch_id)%radii(1)
6803 b = patch_icpp(patch_id)%radii(2)
6804 c = patch_icpp(patch_id)%radii(3)
6805 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
6806 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
6807
6808 ! Initialize eta=1; modified if smoothing is enabled
6809 eta = 1._wp
6810
6811 ! Assign patch vars if cell is covered and patch has write permission
6812 do k = 0, p
6813 do j = 0, n
6814 do i = 0, m
6815 if (grid_geometry == 3) then
6816 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
6817 else
6818 cart_y = y_cc(j)
6819 cart_z = z_cc(k)
6820 end if
6821
6822 if (patch_icpp(patch_id)%smoothen) then
6823 eta = tanh(smooth_coeff/min(dx, dy, &
6824 & dz)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
6825 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
6826 end if
6827
6828 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c) &
6829 & **2 <= 1._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
6830 & k) == smooth_patch_id) then
6831 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
6832
6833
6834 if (patch_icpp(patch_id)%hcid /= dflt_int) then
6835 select case (patch_icpp(patch_id)%hcid)
6836# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6837 case (300) ! Rayleigh-Taylor instability
6838# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6839 rhoh = 3._wp
6840# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6841 rhol = 1._wp
6842# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6843 pref = 1.e5_wp
6844# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6845 pint = pref
6846# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6847 h = 0.7_wp
6848# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6849 lam = 0.2_wp
6850# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6851 wl = 2._wp*pi/lam
6852# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6853 amp = 0.025_wp/wl
6854# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6855
6856# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6857 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
6858# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6859
6860# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6861 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6862# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6863
6864# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6865 if (alph < eps) alph = eps
6866# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6867 if (alph > 1._wp - eps) alph = 1._wp - eps
6868# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6869
6870# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6871 if (y_cc(j) > inth) then
6872# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6873 q_prim_vf(advxb)%sf(i, j, k) = alph
6874# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6875 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
6876# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6877 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
6878# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6879 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
6880# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6881 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6882# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6883 else
6884# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6885 q_prim_vf(advxb)%sf(i, j, k) = alph
6886# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6887 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
6888# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6889 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
6890# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6891 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
6892# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6893 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6894# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6895 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
6896# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6897 end if
6898# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6899 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
6900# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6901 h = 0.0_wp
6902# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6903 lam = 1.0_wp
6904# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6905 amp = patch_icpp(patch_id)%a(2)
6906# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6907 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
6908# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6909 if (x_cc(i) > inth) then
6910# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6911 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
6912# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6913 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
6914# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6915 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
6916# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6917 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
6918# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6919 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
6920# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6921 end if
6922# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6923 case (302) ! 3D Jet with IGR
6924# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6925 ux_th = 10*sqrt(1.4*0.4)
6926# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6927 ux_am = 0.0*sqrt(1.4)
6928# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6929 p_th = 2.0_wp
6930# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6931 p_am = 1.0_wp
6932# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6933 rho_th = 1._wp
6934# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6935 rho_am = 1._wp
6936# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6937 y_th = 0.0_wp
6938# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6939 z_th = 0.0_wp
6940# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6941 r_th = 1._wp
6942# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6943 eps_smooth = 1._wp
6944# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6945 eps = 1e-6
6946# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6947
6948# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6949 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
6950# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6951 rcut = f_cut_on(r - r_th, eps_smooth)
6952# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6953 xcut = f_cut_on(x_cc(i), eps_smooth)
6954# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6955
6956# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6957 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
6958# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6959 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
6960# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6961 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
6962# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6963
6964# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6965 if (num_fluids == 1) then
6966# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6967 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
6968# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6969 else
6970# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6971 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
6972# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6973 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
6974# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6975 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
6976# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6977 end if
6978# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6979
6980# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6981 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
6982# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6983 case (303) ! 3D Multijet
6984# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6985 eps_smooth = 3.0_wp
6986# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6987 ux_th = 10*sqrt(1.4*0.4)
6988# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6989 ux_am = 2.5*sqrt(1.4*0.4)
6990# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6991 p_th = 0.8_wp
6992# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6993 p_am = 0.4_wp
6994# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6995 rho_th = 1._wp
6996# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6997 rho_am = 1._wp
6998# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6999 eps = 1e-6
7000# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7001
7002# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7003 rcut = rcut_arr(j, k)
7004# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7005 xcut = f_cut_on(x_cc(i), eps_smooth)
7006# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7007
7008# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7009 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7010# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7011 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
7012# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7013 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
7014# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7015
7016# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7017 if (num_fluids == 1) then
7018# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7019 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7020# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7021 else
7022# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7023 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7024# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7025 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
7026# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7027 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
7028# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7029 end if
7030# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7031
7032# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7033 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
7034# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7035 case (370) ! 3D extrusion of 2D profile from external data
7036# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7037 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7038# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7039 if (.not. files_loaded) then
7040# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7041 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7042# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7043 do f = 1, max_files
7044# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7045 write (file_num_str, '(I0)') f
7046# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7047 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
7048# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7049 end do
7050# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7051
7052# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7053 ! Common file reading setup
7054# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7055 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7056# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7057 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7058# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7059
7060# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7061 select case (num_dims)
7062# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7063 case (1, 2) ! 1D and 2D cases are similar
7064# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7065 ! Count lines
7066# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7067 line_count = 0
7068# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7069 do
7070# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7071 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7072# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7073 if (ios2 /= 0) exit
7074# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7075 line_count = line_count + 1
7076# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7077 end do
7078# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7079 close (unit2)
7080# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7081
7082# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7083 xrows = line_count
7084# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7085 yrows = 1
7086# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7087 index_x = 0
7088# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7089 if (num_dims == 2) index_x = i
7090# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7091#ifdef MFC_DEBUG
7092# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7093 block
7094# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7095 use iso_fortran_env, only: output_unit
7096# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7097
7098# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7099 print *, 'm_icpp_patches.fpp:569: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7100# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7101
7102# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7103 call flush (output_unit)
7104# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7105 end block
7106# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7107#endif
7108# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7109 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7110# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7111
7112# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7113
7114# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7115
7116# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7117#if defined(MFC_OpenACC)
7118# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7119!$acc enter data create(x_coords, stored_values)
7120# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7121#elif defined(MFC_OpenMP)
7122# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7123!$omp target enter data map(always,alloc:x_coords, stored_values)
7124# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7125#endif
7126# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7127
7128# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7129 ! Read data from all files
7130# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7131 do f = 1, max_files
7132# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7133 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7134# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7135 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7136# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7137
7138# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7139 do iter = 1, xrows
7140# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7141 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7142# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7143 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
7144# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7145 end do
7146# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7147 close (unit)
7148# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7149 end do
7150# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7151
7152# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7153 ! Calculate offsets
7154# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7155 domain_xstart = x_coords(1)
7156# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7157 x_step = x_cc(1) - x_cc(0)
7158# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7159 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)
7160# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7161 global_offset_x = nint(abs(delta_x)/x_step)
7162# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7163 case (3) ! 3D case - determine grid structure
7164# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7165 ! Find yRows by counting rows with same x
7166# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7167 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7168# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7169 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7170# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7171
7172# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7173 yrows = 1
7174# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7175 do
7176# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7177 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7178# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7179 if (ios2 /= 0) exit
7180# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7181 if (dummy_x == x0 .and. dummy_y /= y0) then
7182# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7183 yrows = yrows + 1
7184# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7185 else
7186# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7187 exit
7188# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7189 end if
7190# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7191 end do
7192# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7193 close (unit2)
7194# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7195
7196# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7197 ! Count total rows
7198# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7199 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7200# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7201 nrows = 0
7202# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7203 do
7204# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7205 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7206# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7207 if (ios2 /= 0) exit
7208# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7209 nrows = nrows + 1
7210# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7211 end do
7212# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7213 close (unit2)
7214# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7215
7216# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7217 xrows = nrows/yrows
7218# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7219#ifdef MFC_DEBUG
7220# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7221 block
7222# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7223 use iso_fortran_env, only: output_unit
7224# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7225
7226# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7227 print *, 'm_icpp_patches.fpp:569: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7228# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7229
7230# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7231 call flush (output_unit)
7232# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7233 end block
7234# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7235#endif
7236# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7237 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7238# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7239
7240# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7241
7242# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7243
7244# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7245
7246# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7247#if defined(MFC_OpenACC)
7248# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7249!$acc enter data create(x_coords, y_coords, stored_values)
7250# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7251#elif defined(MFC_OpenMP)
7252# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7253!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7254# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7255#endif
7256# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7257 index_x = i
7258# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7259 index_y = j
7260# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7261
7262# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7263 ! Read all files
7264# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7265 do f = 1, max_files
7266# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7267 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7268# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7269 if (ios /= 0) then
7270# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7271 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7272# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7273 cycle
7274# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7275 end if
7276# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7277
7278# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7279 iter = 0
7280# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7281 do iix = 1, xrows
7282# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7283 do iiy = 1, yrows
7284# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7285 iter = iter + 1
7286# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7287 if (f == 1) then
7288# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7289 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7290# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7291 else
7292# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7293 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7294# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7295 end if
7296# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7297 if (ios /= 0) call s_mpi_abort("Error reading data")
7298# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7299 end do
7300# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7301 end do
7302# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7303 close (unit)
7304# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7305 end do
7306# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7307
7308# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7309 ! Calculate offsets
7310# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7311 x_step = x_cc(1) - x_cc(0)
7312# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7313 y_step = y_cc(1) - y_cc(0)
7314# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7315 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
7316# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7317 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
7318# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7319 global_offset_x = nint(abs(delta_x)/x_step)
7320# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7321 global_offset_y = nint(abs(delta_y)/y_step)
7322# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7323 end select
7324# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7325
7326# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7327 files_loaded = .true.
7328# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7329 end if
7330# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7331
7332# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7333 ! Data assignment
7334# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7335 select case (num_dims)
7336# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7337 case (1)
7338# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7339 idx = i + 1 + global_offset_x
7340# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7341 do f = 1, sys_size
7342# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7343 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
7344# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7345 end do
7346# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7347 case (2)
7348# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7349 idx = i + 1 + global_offset_x - index_x
7350# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7351 do f = 1, sys_size - 1
7352# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7353 jump = merge(1, 0, f >= momxe)
7354# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7355 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
7356# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7357 end do
7358# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7359 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
7360# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7361 case (3)
7362# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7363 idx = i + 1 + global_offset_x - index_x
7364# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7365 idy = j + 1 + global_offset_y - index_y
7366# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7367 do f = 1, sys_size - 1
7368# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7369 jump = merge(1, 0, f >= momxe)
7370# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7371 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
7372# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7373 end do
7374# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7375 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
7376# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7377 end select
7378# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7379 case (380) ! Taylor-Green vortex
7380# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7381 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
7382# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7383 ! geometry 9
7384# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7385 mach = 0.1
7386# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7387 if (patch_id == 1) then
7388# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7389 q_prim_vf(e_idx)%sf(i, j, &
7390# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7391 & 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)
7392# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7393 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
7394# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7395 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
7396# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7397 end if
7398# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7399 case default
7400# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7401 call s_int_to_str(patch_id, istr)
7402# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7403 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
7404# 569 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7405 end select
7406 end if
7407
7408 ! Updating the patch identities bookkeeping variable
7409 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
7410 end if
7411 end do
7412 end do
7413 end do
7414 if (allocated(stored_values)) then
7415# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7416#ifdef MFC_DEBUG
7417# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7418 block
7419# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7420 use iso_fortran_env, only: output_unit
7421# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7422
7423# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7424 print *, 'm_icpp_patches.fpp:578: ', '@:DEALLOCATE(stored_values)'
7425# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7426
7427# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7428 call flush (output_unit)
7429# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7430 end block
7431# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7432#endif
7433# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7434
7435# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7436#if defined(MFC_OpenACC)
7437# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7438!$acc exit data delete(stored_values)
7439# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7440#elif defined(MFC_OpenMP)
7441# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7442!$omp target exit data map(release:stored_values)
7443# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7444#endif
7445# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7446 deallocate (stored_values)
7447# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7448#ifdef MFC_DEBUG
7449# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7450 block
7451# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7452 use iso_fortran_env, only: output_unit
7453# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7454
7455# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7456 print *, 'm_icpp_patches.fpp:578: ', '@:DEALLOCATE(x_coords)'
7457# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7458
7459# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7460 call flush (output_unit)
7461# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7462 end block
7463# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7464#endif
7465# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7466
7467# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7468#if defined(MFC_OpenACC)
7469# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7470!$acc exit data delete(x_coords)
7471# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7472#elif defined(MFC_OpenMP)
7473# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7474!$omp target exit data map(release:x_coords)
7475# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7476#endif
7477# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7478 deallocate (x_coords)
7479# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7480 end if
7481# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7482
7483# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7484 if (allocated(y_coords)) then
7485# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7486#ifdef MFC_DEBUG
7487# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7488 block
7489# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7490 use iso_fortran_env, only: output_unit
7491# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7492
7493# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7494 print *, 'm_icpp_patches.fpp:578: ', '@:DEALLOCATE(y_coords)'
7495# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7496
7497# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7498 call flush (output_unit)
7499# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7500 end block
7501# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7502#endif
7503# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7504
7505# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7506#if defined(MFC_OpenACC)
7507# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7508!$acc exit data delete(y_coords)
7509# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7510#elif defined(MFC_OpenMP)
7511# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7512!$omp target exit data map(release:y_coords)
7513# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7514#endif
7515# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7516 deallocate (y_coords)
7517# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7518 end if
7519
7520 end subroutine s_icpp_ellipsoid
7521
7522 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
7523 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
7524 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
7525 !! allow for the smoothing of its boundaries.
7526 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
7527
7528 integer, intent(in) :: patch_id
7529
7530#ifdef MFC_MIXED_PRECISION
7531 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7532#else
7533 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7534#endif
7535 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7536 integer :: i, j, k !< generic loop iterators
7537 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
7538
7539 integer :: xRows, yRows, nRows, iix, iiy, max_files
7540# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7541 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7542# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7543 real(wp) :: x_len, x_step, y_len, y_step
7544# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7545 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7546# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7547 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7548# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7549 real(wp) :: delta_x, delta_y
7550# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7551 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7552# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7553 character(len=200) :: errmsg
7554# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7555 real(wp), allocatable :: stored_values(:,:,:)
7556# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7557 real(wp), allocatable :: x_coords(:), y_coords(:)
7558# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7559 logical :: files_loaded = .false.
7560# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7561 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7562# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7563 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
7564# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7565 character(len=20) :: file_num_str !< For storing the file number as a string
7566# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7567 character(len=20) :: zeros_part !< For the trailing zeros part
7568# 599 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7569 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
7570 ! Place any declaration of intermediate variables here
7571# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572 real(wp) :: eps, eps_mhd, C_mhd
7573# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 real(wp) :: r, rmax, gam, umax, p0
7575# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
7577# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578 real(wp) :: factor
7579# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 real(wp) :: r0, alpha, r2
7581# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582 real(wp) :: sinA, cosA
7583# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584 real(wp) :: r_sq
7585# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586
7587# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588 ! # 207
7589# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590 real(wp) :: sigma, gauss1, gauss2
7591# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592 ! # 208
7593# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
7595# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596
7597# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598 eps = 1.e-9_wp
7599
7600 pi_inf = pi_infs(1)
7601 gamma = gammas(1)
7602 lit_gamma = gs_min(1)
7603
7604 ! Transferring the rectangle's centroid and length information
7605 x_centroid = patch_icpp(patch_id)%x_centroid
7606 y_centroid = patch_icpp(patch_id)%y_centroid
7607 length_x = patch_icpp(patch_id)%length_x
7608 length_y = patch_icpp(patch_id)%length_y
7609
7610 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
7611 x_boundary%beg = x_centroid - 0.5_wp*length_x
7612 x_boundary%end = x_centroid + 0.5_wp*length_x
7613 y_boundary%beg = y_centroid - 0.5_wp*length_y
7614 y_boundary%end = y_centroid + 0.5_wp*length_y
7615
7616 ! Set eta=1 (no smoothing for this patch type)
7617 eta = 1._wp
7618
7619 ! Assign patch vars if cell is covered and patch has write permission
7620 do j = 0, n
7621 do i = 0, m
7622 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
7623 & .and. y_boundary%end >= y_cc(j)) then
7624 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
7625 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
7626
7627
7628
7629 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7630 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
7631# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 case (200) ! Two-fluid cubic interface
7633# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
7635# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636 ! Volume Fractions
7637# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 q_prim_vf(advxb)%sf(i, j, 0) = eps
7639# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
7641# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
7643# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
7645# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
7647# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 end if
7649# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
7651# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7653# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 rmax = 0.2_wp
7655# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656
7657# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7659# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7661# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7663# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664
7665# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 if (r < rmax) then
7667# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7669# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7671# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7673# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674 else if (r < 2*rmax) then
7675# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7677# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7679# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
7681# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 else
7683# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
7685# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
7687# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
7689# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690 end if
7691# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
7693# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7695# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696 rmax = 0.2_wp
7697# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698
7699# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7701# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7703# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7705# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706
7707# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708 if (r < rmax) then
7709# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7711# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7713# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7715# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716 else if (r < 2*rmax) then
7717# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7719# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7721# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
7723# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724 else
7725# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
7727# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
7729# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
7731# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732 end if
7733# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734
7735# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
7737# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738 case (204) ! Rayleigh-Taylor instability
7739# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740 rhoh = 3._wp
7741# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 rhol = 1._wp
7743# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 pref = 1.e5_wp
7745# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 pint = pref
7747# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748 h = 0.7_wp
7749# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 lam = 0.2_wp
7751# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752 wl = 2._wp*pi/lam
7753# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754 amp = 0.05_wp/wl
7755# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756
7757# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
7759# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760
7761# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7763# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764
7765# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 if (alph < eps) alph = eps
7767# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 if (alph > 1._wp - eps) alph = 1._wp - eps
7769# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770
7771# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 if (y_cc(j) > inth) then
7773# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 q_prim_vf(advxb)%sf(i, j, 0) = alph
7775# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
7777# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
7779# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
7781# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7783# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 else
7785# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786 q_prim_vf(advxb)%sf(i, j, 0) = alph
7787# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
7789# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
7791# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
7793# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7795# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
7797# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798 end if
7799# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800 case (205) ! 2D lung wave interaction problem
7801# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802 h = 0.0_wp ! non dim origin y
7803# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804 lam = 1.0_wp ! non dim lambda
7805# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
7807# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808
7809# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
7811# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812
7813# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814 if (y_cc(j) > inth) then
7815# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7817# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7819# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
7821# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7823# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7825# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826 end if
7827# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 case (206) ! 2D lung wave interaction problem - horizontal domain
7829# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830 h = 0.0_wp ! non dim origin y
7831# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 lam = 1.0_wp ! non dim lambda
7833# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 amp = patch_icpp(patch_id)%a(2)
7835# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836
7837# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
7839# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840
7841# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842 if (x_cc(i) > intl) then ! this is the liquid
7843# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7845# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7847# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
7849# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7851# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7853# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854 end if
7855# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 case (207) ! Kelvin Helmholtz Instability
7857# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858 sigma = 0.05_wp/sqrt(2.0_wp)
7859# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
7861# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
7863# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
7865# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 case (208) ! Richtmeyer Meshkov Instability
7867# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 lam = 1.0_wp
7869# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870 eps = 1.0e-6_wp
7871# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 ei = 5.0_wp
7873# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874 ! Smoothening function to smooth out sharp discontinuity in the interface
7875# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 if (x_cc(i) <= 0.7_wp*lam) then
7877# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
7879# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
7881# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
7883# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884 alpha_sf6 = 1.0_wp - alpha_air
7885# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
7887# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
7889# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
7891# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7892 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
7893# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7894 end if
7895# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7896 case (250) ! MHD Orszag-Tang vortex
7897# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7898 ! 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),
7899# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7900 ! sin(4*pi*x)/sqrt(4*pi), 0)
7901# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7902
7903# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7904 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
7905# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7906 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
7907# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7908
7909# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7910 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
7911# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7912 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
7913# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7914 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
7915# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7916 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
7917# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7918 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
7919# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7920 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
7921# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7922 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
7923# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7924 ! Linear interpolation between r=0.08 and r=1.0
7925# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7926 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
7927# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7928 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
7929# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7930 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
7931# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7932 else
7933# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7934 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
7935# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7936 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
7937# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7938 end if
7939# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7940
7941# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7942 ! case 252 is for the 2D MHD Rotor problem
7943# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7944 case (252) ! 2D MHD Rotor Problem
7945# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7946 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
7947# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7948 !
7949# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7950 ! 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
7951# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7952 ! velocity w=20, giving v_tan=2 at r=0.1
7953# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7954
7955# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7956 ! Calculate distance squared from the center
7957# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7958 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
7959# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7960
7961# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7962 ! inner radius of 0.1
7963# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7964 if (r_sq <= 0.1**2) then
7965# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7966 ! -- Inside the rotor -- Set density uniformly to 10
7967# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7968 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
7969# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7970
7971# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7972 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
7973# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7974 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
7975# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7976 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
7977# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7978
7979# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7980 ! taper width of 0.015
7981# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7982 else if (r_sq <= 0.115**2) then
7983# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7984 ! linearly smooth the function between r = 0.1 and 0.115
7985# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7986 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
7987# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7988
7989# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7990 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
7991# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7992 q_prim_vf(momxb + 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)
7993# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7994 end if
7995# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7996 case (253) ! MHD Smooth Magnetic Vortex
7997# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7998 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
7999# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8000 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8001# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8002
8003# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8004 ! velocity
8005# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8006 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8007# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8008 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8009# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8010
8011# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8012 ! magnetic field
8013# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8014 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8015# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8016 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8017# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8018
8019# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8020 ! pressure
8021# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8022 q_prim_vf(e_idx)%sf(i, j, &
8023# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8024 & 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)
8025# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8026 case (260) ! Gaussian Divergence Pulse
8027# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8028 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
8029# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8030 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
8031# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8032 ! initialized to zero everywhere.
8033# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8034
8035# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 eps_mhd = patch_icpp(patch_id)%a(2)
8037# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 sigma = patch_icpp(patch_id)%a(3)
8039# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8041# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042
8043# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044 ! B-field
8045# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8047# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048 case (261) ! Blob
8049# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050 r0 = 1._wp/sqrt(8._wp)
8051# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052 r2 = x_cc(i)**2 + y_cc(j)**2
8053# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054 r = sqrt(r2)
8055# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056 alpha = r/r0
8057# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058 if (alpha < 1) then
8059# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
8061# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8062 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
8063# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8064 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
8065# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8066 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
8067# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8068 end if
8069# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8070 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
8071# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8072 ! rotate by \alpha = atan(2)
8073# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8074 alpha = atan(2._wp)
8075# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8076 cosa = cos(alpha)
8077# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8078 sina = sin(alpha)
8079# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8080 ! projection along shock normal
8081# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8082 r = x_cc(i)*cosa + y_cc(j)*sina
8083# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8084
8085# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8086 if (r <= 0.5_wp) then
8087# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8088 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
8089# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8090 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8091# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8092 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
8093# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8094 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
8095# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8096 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
8097# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8098 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8099# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8100 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8101# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8102 else
8103# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8104 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
8105# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8106 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8107# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8108 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
8109# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8110 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
8111# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8112 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
8113# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8114 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8115# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8116 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8117# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8118 end if
8119# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8120 ! v^z and B^z remain zero by default
8121# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8122 case (270) ! 2D extrusion of 1D profile from external data
8123# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8124 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8125# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8126 if (.not. files_loaded) then
8127# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8128 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8129# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8130 do f = 1, max_files
8131# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8132 write (file_num_str, '(I0)') f
8133# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8134 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
8135# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8136 end do
8137# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8138
8139# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8140 ! Common file reading setup
8141# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8142 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8143# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8144 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8145# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8146
8147# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8148 select case (num_dims)
8149# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8150 case (1, 2) ! 1D and 2D cases are similar
8151# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8152 ! Count lines
8153# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8154 line_count = 0
8155# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8156 do
8157# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8158 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8159# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8160 if (ios2 /= 0) exit
8161# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8162 line_count = line_count + 1
8163# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8164 end do
8165# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8166 close (unit2)
8167# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8168
8169# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8170 xrows = line_count
8171# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8172 yrows = 1
8173# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8174 index_x = 0
8175# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8176 if (num_dims == 2) index_x = i
8177# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8178#ifdef MFC_DEBUG
8179# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8180 block
8181# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8182 use iso_fortran_env, only: output_unit
8183# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8184
8185# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8186 print *, 'm_icpp_patches.fpp:632: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8187# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8188
8189# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8190 call flush (output_unit)
8191# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8192 end block
8193# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8194#endif
8195# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8196 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8197# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8198
8199# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8200
8201# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8202
8203# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8204#if defined(MFC_OpenACC)
8205# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8206!$acc enter data create(x_coords, stored_values)
8207# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8208#elif defined(MFC_OpenMP)
8209# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8210!$omp target enter data map(always,alloc:x_coords, stored_values)
8211# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8212#endif
8213# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8214
8215# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8216 ! Read data from all files
8217# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8218 do f = 1, max_files
8219# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8220 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8221# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8222 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8223# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8224
8225# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8226 do iter = 1, xrows
8227# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8228 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8229# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8230 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8231# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8232 end do
8233# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8234 close (unit)
8235# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8236 end do
8237# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8238
8239# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8240 ! Calculate offsets
8241# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8242 domain_xstart = x_coords(1)
8243# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8244 x_step = x_cc(1) - x_cc(0)
8245# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8246 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)
8247# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8248 global_offset_x = nint(abs(delta_x)/x_step)
8249# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8250 case (3) ! 3D case - determine grid structure
8251# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8252 ! Find yRows by counting rows with same x
8253# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8254 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8255# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8256 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8257# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8258
8259# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8260 yrows = 1
8261# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8262 do
8263# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8264 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8265# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8266 if (ios2 /= 0) exit
8267# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8268 if (dummy_x == x0 .and. dummy_y /= y0) then
8269# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8270 yrows = yrows + 1
8271# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8272 else
8273# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8274 exit
8275# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8276 end if
8277# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8278 end do
8279# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8280 close (unit2)
8281# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8282
8283# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8284 ! Count total rows
8285# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8286 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8287# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8288 nrows = 0
8289# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8290 do
8291# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8292 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8293# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8294 if (ios2 /= 0) exit
8295# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8296 nrows = nrows + 1
8297# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8298 end do
8299# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8300 close (unit2)
8301# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8302
8303# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8304 xrows = nrows/yrows
8305# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8306#ifdef MFC_DEBUG
8307# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8308 block
8309# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8310 use iso_fortran_env, only: output_unit
8311# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8312
8313# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8314 print *, 'm_icpp_patches.fpp:632: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8315# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8316
8317# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8318 call flush (output_unit)
8319# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8320 end block
8321# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8322#endif
8323# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8324 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8325# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8326
8327# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8328
8329# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8330
8331# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8332
8333# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8334#if defined(MFC_OpenACC)
8335# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8336!$acc enter data create(x_coords, y_coords, stored_values)
8337# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8338#elif defined(MFC_OpenMP)
8339# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8340!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8341# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8342#endif
8343# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8344 index_x = i
8345# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8346 index_y = j
8347# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8348
8349# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8350 ! Read all files
8351# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8352 do f = 1, max_files
8353# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8354 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8355# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8356 if (ios /= 0) then
8357# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8358 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8359# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8360 cycle
8361# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8362 end if
8363# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8364
8365# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8366 iter = 0
8367# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8368 do iix = 1, xrows
8369# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8370 do iiy = 1, yrows
8371# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8372 iter = iter + 1
8373# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8374 if (f == 1) then
8375# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8376 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8377# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8378 else
8379# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8380 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8381# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8382 end if
8383# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8384 if (ios /= 0) call s_mpi_abort("Error reading data")
8385# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8386 end do
8387# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8388 end do
8389# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8390 close (unit)
8391# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8392 end do
8393# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8394
8395# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8396 ! Calculate offsets
8397# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8398 x_step = x_cc(1) - x_cc(0)
8399# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8400 y_step = y_cc(1) - y_cc(0)
8401# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8402 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
8403# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8404 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
8405# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8406 global_offset_x = nint(abs(delta_x)/x_step)
8407# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8408 global_offset_y = nint(abs(delta_y)/y_step)
8409# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8410 end select
8411# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8412
8413# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8414 files_loaded = .true.
8415# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8416 end if
8417# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8418
8419# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8420 ! Data assignment
8421# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8422 select case (num_dims)
8423# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8424 case (1)
8425# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8426 idx = i + 1 + global_offset_x
8427# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8428 do f = 1, sys_size
8429# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8430 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8431# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8432 end do
8433# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8434 case (2)
8435# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8436 idx = i + 1 + global_offset_x - index_x
8437# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8438 do f = 1, sys_size - 1
8439# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8440 jump = merge(1, 0, f >= momxe)
8441# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8442 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8443# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8444 end do
8445# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8446 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
8447# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8448 case (3)
8449# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8450 idx = i + 1 + global_offset_x - index_x
8451# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8452 idy = j + 1 + global_offset_y - index_y
8453# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8454 do f = 1, sys_size - 1
8455# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8456 jump = merge(1, 0, f >= momxe)
8457# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8458 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8459# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8460 end do
8461# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8462 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
8463# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8464 end select
8465# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8466 case (280) ! Isentropic vortex
8467# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8468 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
8469# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8470 ! geometry 2
8471# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8472 if (patch_id == 1) then
8473# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8474 q_prim_vf(e_idx)%sf(i, j, &
8475# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8476 & 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) &
8477# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8478 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
8479# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8480 q_prim_vf(contxb + 0)%sf(i, j, &
8481# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8482 & 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) &
8483# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8484 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
8485# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8486 q_prim_vf(momxb + 0)%sf(i, j, &
8487# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8488 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
8489# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8490 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
8491# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8492 q_prim_vf(momxb + 1)%sf(i, j, &
8493# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8494 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
8495# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8496 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
8497# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8498 end if
8499# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8500 case (281) ! Acoustic pulse
8501# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8502 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
8503# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8504 ! geometry 2
8505# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8506 if (patch_id == 2) then
8507# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8508 q_prim_vf(e_idx)%sf(i, j, &
8509# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8510 & 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))
8511# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8512 q_prim_vf(contxb + 0)%sf(i, j, &
8513# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8514 & 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))
8515# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8516 end if
8517# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8518 case (282) ! Zero-circulation vortex
8519# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8520 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
8521# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8522 ! geometry 2
8523# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8524 if (patch_id == 2) then
8525# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8526 q_prim_vf(e_idx)%sf(i, j, &
8527# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8528 & 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))
8529# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8530 q_prim_vf(contxb + 0)%sf(i, j, &
8531# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8532 & 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))
8533# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8534 q_prim_vf(momxb + 0)%sf(i, j, &
8535# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8536 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
8537# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8538 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
8539# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8540 end if
8541# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8542 case default
8543# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8544 if (proc_rank == 0) then
8545# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8546 call s_int_to_str(patch_id, istr)
8547# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8548 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
8549# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8550 end if
8551# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8552 end select
8553 end if
8554
8555 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then
8556 ! zero density, reassign according to Tait EOS
8557 q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(e_idx)%sf(i, j, &
8558 & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(alf_idx) &
8559 & %sf(i, j, 0))
8560 end if
8561
8562 ! Updating the patch identities bookkeeping variable
8563 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
8564 end if
8565 end if
8566 end do
8567 end do
8568 if (allocated(stored_values)) then
8569# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8570#ifdef MFC_DEBUG
8571# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8572 block
8573# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8574 use iso_fortran_env, only: output_unit
8575# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8576
8577# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8578 print *, 'm_icpp_patches.fpp:648: ', '@:DEALLOCATE(stored_values)'
8579# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8580
8581# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8582 call flush (output_unit)
8583# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8584 end block
8585# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8586#endif
8587# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8588
8589# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8590#if defined(MFC_OpenACC)
8591# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8592!$acc exit data delete(stored_values)
8593# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8594#elif defined(MFC_OpenMP)
8595# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8596!$omp target exit data map(release:stored_values)
8597# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8598#endif
8599# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8600 deallocate (stored_values)
8601# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8602#ifdef MFC_DEBUG
8603# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8604 block
8605# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8606 use iso_fortran_env, only: output_unit
8607# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8608
8609# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8610 print *, 'm_icpp_patches.fpp:648: ', '@:DEALLOCATE(x_coords)'
8611# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8612
8613# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8614 call flush (output_unit)
8615# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8616 end block
8617# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8618#endif
8619# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8620
8621# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8622#if defined(MFC_OpenACC)
8623# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8624!$acc exit data delete(x_coords)
8625# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8626#elif defined(MFC_OpenMP)
8627# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8628!$omp target exit data map(release:x_coords)
8629# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8630#endif
8631# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8632 deallocate (x_coords)
8633# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8634 end if
8635# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8636
8637# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8638 if (allocated(y_coords)) then
8639# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8640#ifdef MFC_DEBUG
8641# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8642 block
8643# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8644 use iso_fortran_env, only: output_unit
8645# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8646
8647# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8648 print *, 'm_icpp_patches.fpp:648: ', '@:DEALLOCATE(y_coords)'
8649# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8650
8651# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8652 call flush (output_unit)
8653# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8654 end block
8655# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8656#endif
8657# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8658
8659# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8660#if defined(MFC_OpenACC)
8661# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8662!$acc exit data delete(y_coords)
8663# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8664#elif defined(MFC_OpenMP)
8665# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8666!$omp target exit data map(release:y_coords)
8667# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8668#endif
8669# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8670 deallocate (y_coords)
8671# 648 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8672 end if
8673
8674 end subroutine s_icpp_rectangle
8675
8676 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
8677 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
8678 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
8679 !! the smoothing of its boundary.
8680 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
8681
8682 integer, intent(in) :: patch_id
8683
8684#ifdef MFC_MIXED_PRECISION
8685 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8686#else
8687 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8688#endif
8689 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8690 integer :: i, j, k !< Generic loop operators
8691 real(wp) :: a, b, c
8692
8693 integer :: xRows, yRows, nRows, iix, iiy, max_files
8694# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8695 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8696# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8697 real(wp) :: x_len, x_step, y_len, y_step
8698# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8699 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8700# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8701 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
8702# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8703 real(wp) :: delta_x, delta_y
8704# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8705 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
8706# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8707 character(len=200) :: errmsg
8708# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8709 real(wp), allocatable :: stored_values(:,:,:)
8710# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8711 real(wp), allocatable :: x_coords(:), y_coords(:)
8712# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8713 logical :: files_loaded = .false.
8714# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8715 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8716# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8717 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
8718# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8719 character(len=20) :: file_num_str !< For storing the file number as a string
8720# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8721 character(len=20) :: zeros_part !< For the trailing zeros part
8722# 669 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8723 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
8724 ! Place any declaration of intermediate variables here
8725# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8726 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
8727# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8728 real(wp) :: eps
8729# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8730
8731# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8732 ! IGR Jets Arrays to stor position and radii of jets from input file
8733# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8734 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
8735# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8736 ! Variables to describe initial condition of jet
8737# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8738 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
8739# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8740 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
8741# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8742 real(wp), dimension(0:n,0:p) :: rcut_arr
8743# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8744 integer :: l, q, s !< Iterators for reading input files
8745# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8746 integer :: start, end !< Ints to keep track of position in file
8747# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8748 character(len=1000) :: line !< String to store line in file
8749# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8750 character(len=25) :: value !< String to store value in line
8751# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8752 integer :: NJet !< Number of jets
8753# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8754
8755# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8756 eps = 1e-9_wp
8757# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8758
8759# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8760 if (patch_icpp(patch_id)%hcid == 303) then
8761# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8762 eps_smooth = 3._wp
8763# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8764 open (unit=10, file="njet.txt", status="old", action="read")
8765# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8766 read (10, *) njet
8767# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8768 close (10)
8769# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8770
8771# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8772 allocate (y_th_arr(0:njet - 1))
8773# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8774 allocate (z_th_arr(0:njet - 1))
8775# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8776 allocate (r_th_arr(0:njet - 1))
8777# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8778
8779# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8780 open (unit=10, file="jets.csv", status="old", action="read")
8781# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8782 do q = 0, njet - 1
8783# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8784 read (10, '(A)') line ! Read a full line as a string
8785# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8786 start = 1
8787# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8788
8789# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8790 do l = 0, 2
8791# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8792 end = index(line(start:), ',') ! Find the next comma
8793# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8794 if (end == 0) then
8795# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8796 value = trim(adjustl(line(start:))) ! Last value in the line
8797# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8798 else
8799# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8800 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
8801# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8802 start = start + end ! Move to next value
8803# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8804 end if
8805# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8806 if (l == 0) then
8807# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8808 read (value, *) y_th_arr(q) ! Convert string to numeric value
8809# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8810 else if (l == 1) then
8811# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8812 read (value, *) z_th_arr(q)
8813# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8814 else
8815# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8816 read (value, *) r_th_arr(q)
8817# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8818 end if
8819# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8820 end do
8821# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8822 end do
8823# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8824 close (10)
8825# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8826
8827# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8828 do q = 0, p
8829# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8830 do l = 0, n
8831# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8832 rcut = 0._wp
8833# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8834 do s = 0, njet - 1
8835# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8836 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
8837# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8838 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
8839# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8840 end do
8841# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8842 rcut_arr(l, q) = rcut
8843# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8844 end do
8845# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8846 end do
8847# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8848 end if
8849
8850 ! Transferring the centroid information of the line to be swept
8851 x_centroid = patch_icpp(patch_id)%x_centroid
8852 y_centroid = patch_icpp(patch_id)%y_centroid
8853 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
8854 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
8855
8856 ! Obtaining coefficients of the equation describing the sweep line
8857 a = patch_icpp(patch_id)%normal(1)
8858 b = patch_icpp(patch_id)%normal(2)
8859 c = -a*x_centroid - b*y_centroid
8860
8861 ! Initialize eta=1; modified if smoothing is enabled
8862 eta = 1._wp
8863
8864 ! Assign patch vars if cell is covered and patch has write permission
8865 do j = 0, n
8866 do i = 0, m
8867 if (patch_icpp(patch_id)%smoothen) then
8868 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))
8869 end if
8870
8871 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
8872 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
8873 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
8874
8875
8876 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8877 select case (patch_icpp(patch_id)%hcid)
8878# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8879 case (300) ! Rayleigh-Taylor instability
8880# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8881 rhoh = 3._wp
8882# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8883 rhol = 1._wp
8884# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8885 pref = 1.e5_wp
8886# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8887 pint = pref
8888# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8889 h = 0.7_wp
8890# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8891 lam = 0.2_wp
8892# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8893 wl = 2._wp*pi/lam
8894# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8895 amp = 0.025_wp/wl
8896# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8897
8898# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8899 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
8900# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8901
8902# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8903 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8904# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8905
8906# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8907 if (alph < eps) alph = eps
8908# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8909 if (alph > 1._wp - eps) alph = 1._wp - eps
8910# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8911
8912# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8913 if (y_cc(j) > inth) then
8914# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8915 q_prim_vf(advxb)%sf(i, j, k) = alph
8916# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8917 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
8918# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8919 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
8920# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8921 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
8922# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8923 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8924# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8925 else
8926# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8927 q_prim_vf(advxb)%sf(i, j, k) = alph
8928# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8929 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
8930# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8931 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
8932# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8933 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
8934# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8935 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8936# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8937 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
8938# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8939 end if
8940# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8941 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
8942# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8943 h = 0.0_wp
8944# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8945 lam = 1.0_wp
8946# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8947 amp = patch_icpp(patch_id)%a(2)
8948# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8949 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
8950# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8951 if (x_cc(i) > inth) then
8952# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8953 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
8954# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8955 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
8956# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8957 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
8958# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8959 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
8960# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8961 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
8962# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8963 end if
8964# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8965 case (302) ! 3D Jet with IGR
8966# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8967 ux_th = 10*sqrt(1.4*0.4)
8968# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8969 ux_am = 0.0*sqrt(1.4)
8970# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8971 p_th = 2.0_wp
8972# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8973 p_am = 1.0_wp
8974# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8975 rho_th = 1._wp
8976# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8977 rho_am = 1._wp
8978# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8979 y_th = 0.0_wp
8980# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8981 z_th = 0.0_wp
8982# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8983 r_th = 1._wp
8984# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8985 eps_smooth = 1._wp
8986# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8987 eps = 1e-6
8988# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8989
8990# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8991 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
8992# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8993 rcut = f_cut_on(r - r_th, eps_smooth)
8994# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8995 xcut = f_cut_on(x_cc(i), eps_smooth)
8996# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8997
8998# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8999 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9000# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9001 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9002# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9003 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9004# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9005
9006# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9007 if (num_fluids == 1) then
9008# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9009 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9010# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9011 else
9012# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9013 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9014# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9015 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9016# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9017 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9018# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9019 end if
9020# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9021
9022# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9023 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9024# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9025 case (303) ! 3D Multijet
9026# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9027 eps_smooth = 3.0_wp
9028# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9029 ux_th = 10*sqrt(1.4*0.4)
9030# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9031 ux_am = 2.5*sqrt(1.4*0.4)
9032# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9033 p_th = 0.8_wp
9034# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9035 p_am = 0.4_wp
9036# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9037 rho_th = 1._wp
9038# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9039 rho_am = 1._wp
9040# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9041 eps = 1e-6
9042# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9043
9044# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9045 rcut = rcut_arr(j, k)
9046# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9047 xcut = f_cut_on(x_cc(i), eps_smooth)
9048# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9049
9050# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9051 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9052# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9053 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9054# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9055 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9056# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9057
9058# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9059 if (num_fluids == 1) then
9060# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9061 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9062# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9063 else
9064# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9065 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9066# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9067 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9068# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9069 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9070# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9071 end if
9072# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9073
9074# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9075 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9076# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9077 case (370) ! 3D extrusion of 2D profile from external data
9078# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9079 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9080# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9081 if (.not. files_loaded) then
9082# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9083 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9084# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9085 do f = 1, max_files
9086# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9087 write (file_num_str, '(I0)') f
9088# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9089 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
9090# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9091 end do
9092# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9093
9094# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9095 ! Common file reading setup
9096# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9097 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9098# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9099 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9100# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9101
9102# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9103 select case (num_dims)
9104# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9105 case (1, 2) ! 1D and 2D cases are similar
9106# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9107 ! Count lines
9108# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9109 line_count = 0
9110# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9111 do
9112# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9113 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9114# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9115 if (ios2 /= 0) exit
9116# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9117 line_count = line_count + 1
9118# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9119 end do
9120# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9121 close (unit2)
9122# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9123
9124# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9125 xrows = line_count
9126# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9127 yrows = 1
9128# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9129 index_x = 0
9130# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9131 if (num_dims == 2) index_x = i
9132# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9133#ifdef MFC_DEBUG
9134# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9135 block
9136# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9137 use iso_fortran_env, only: output_unit
9138# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9139
9140# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9141 print *, 'm_icpp_patches.fpp:699: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9142# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9143
9144# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9145 call flush (output_unit)
9146# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9147 end block
9148# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9149#endif
9150# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9151 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9152# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9153
9154# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9155
9156# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9157
9158# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9159#if defined(MFC_OpenACC)
9160# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9161!$acc enter data create(x_coords, stored_values)
9162# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9163#elif defined(MFC_OpenMP)
9164# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9165!$omp target enter data map(always,alloc:x_coords, stored_values)
9166# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9167#endif
9168# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9169
9170# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9171 ! Read data from all files
9172# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9173 do f = 1, max_files
9174# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9175 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9176# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9177 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9178# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9179
9180# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9181 do iter = 1, xrows
9182# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9183 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9184# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9185 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
9186# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9187 end do
9188# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9189 close (unit)
9190# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9191 end do
9192# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9193
9194# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9195 ! Calculate offsets
9196# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9197 domain_xstart = x_coords(1)
9198# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9199 x_step = x_cc(1) - x_cc(0)
9200# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9201 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)
9202# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9203 global_offset_x = nint(abs(delta_x)/x_step)
9204# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9205 case (3) ! 3D case - determine grid structure
9206# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9207 ! Find yRows by counting rows with same x
9208# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9209 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9210# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9211 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9212# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9213
9214# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9215 yrows = 1
9216# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9217 do
9218# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9219 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9220# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9221 if (ios2 /= 0) exit
9222# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9223 if (dummy_x == x0 .and. dummy_y /= y0) then
9224# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9225 yrows = yrows + 1
9226# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9227 else
9228# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9229 exit
9230# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9231 end if
9232# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9233 end do
9234# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9235 close (unit2)
9236# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9237
9238# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9239 ! Count total rows
9240# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9241 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9242# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9243 nrows = 0
9244# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9245 do
9246# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9247 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9248# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9249 if (ios2 /= 0) exit
9250# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9251 nrows = nrows + 1
9252# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9253 end do
9254# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9255 close (unit2)
9256# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9257
9258# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9259 xrows = nrows/yrows
9260# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9261#ifdef MFC_DEBUG
9262# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9263 block
9264# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9265 use iso_fortran_env, only: output_unit
9266# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9267
9268# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9269 print *, 'm_icpp_patches.fpp:699: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9270# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9271
9272# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9273 call flush (output_unit)
9274# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9275 end block
9276# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9277#endif
9278# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9279 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9280# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9281
9282# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9283
9284# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9285
9286# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9287
9288# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9289#if defined(MFC_OpenACC)
9290# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9291!$acc enter data create(x_coords, y_coords, stored_values)
9292# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9293#elif defined(MFC_OpenMP)
9294# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9295!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9296# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9297#endif
9298# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9299 index_x = i
9300# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9301 index_y = j
9302# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9303
9304# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9305 ! Read all files
9306# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9307 do f = 1, max_files
9308# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9309 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9310# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9311 if (ios /= 0) then
9312# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9313 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9314# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9315 cycle
9316# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9317 end if
9318# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9319
9320# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9321 iter = 0
9322# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9323 do iix = 1, xrows
9324# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9325 do iiy = 1, yrows
9326# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9327 iter = iter + 1
9328# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9329 if (f == 1) then
9330# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9331 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9332# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9333 else
9334# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9335 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9336# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9337 end if
9338# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9339 if (ios /= 0) call s_mpi_abort("Error reading data")
9340# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9341 end do
9342# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9343 end do
9344# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9345 close (unit)
9346# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9347 end do
9348# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9349
9350# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9351 ! Calculate offsets
9352# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9353 x_step = x_cc(1) - x_cc(0)
9354# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9355 y_step = y_cc(1) - y_cc(0)
9356# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9357 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9358# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9359 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9360# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9361 global_offset_x = nint(abs(delta_x)/x_step)
9362# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9363 global_offset_y = nint(abs(delta_y)/y_step)
9364# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9365 end select
9366# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9367
9368# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9369 files_loaded = .true.
9370# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9371 end if
9372# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9373
9374# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9375 ! Data assignment
9376# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9377 select case (num_dims)
9378# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9379 case (1)
9380# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9381 idx = i + 1 + global_offset_x
9382# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9383 do f = 1, sys_size
9384# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9385 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9386# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9387 end do
9388# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9389 case (2)
9390# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9391 idx = i + 1 + global_offset_x - index_x
9392# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9393 do f = 1, sys_size - 1
9394# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9395 jump = merge(1, 0, f >= momxe)
9396# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9397 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9398# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9399 end do
9400# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9401 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
9402# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9403 case (3)
9404# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9405 idx = i + 1 + global_offset_x - index_x
9406# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9407 idy = j + 1 + global_offset_y - index_y
9408# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9409 do f = 1, sys_size - 1
9410# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9411 jump = merge(1, 0, f >= momxe)
9412# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9413 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9414# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9415 end do
9416# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9417 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
9418# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9419 end select
9420# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9421 case (380) ! Taylor-Green vortex
9422# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9423 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
9424# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9425 ! geometry 9
9426# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9427 mach = 0.1
9428# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9429 if (patch_id == 1) then
9430# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9431 q_prim_vf(e_idx)%sf(i, j, &
9432# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9433 & 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)
9434# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9435 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
9436# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9437 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
9438# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9439 end if
9440# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9441 case default
9442# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9443 call s_int_to_str(patch_id, istr)
9444# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9445 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
9446# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9447 end select
9448 end if
9449
9450 ! Updating the patch identities bookkeeping variable
9451 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9452 end if
9453 end do
9454 end do
9455 if (allocated(stored_values)) then
9456# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9457#ifdef MFC_DEBUG
9458# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9459 block
9460# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9461 use iso_fortran_env, only: output_unit
9462# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9463
9464# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9465 print *, 'm_icpp_patches.fpp:707: ', '@:DEALLOCATE(stored_values)'
9466# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9467
9468# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9469 call flush (output_unit)
9470# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9471 end block
9472# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9473#endif
9474# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9475
9476# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9477#if defined(MFC_OpenACC)
9478# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9479!$acc exit data delete(stored_values)
9480# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9481#elif defined(MFC_OpenMP)
9482# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9483!$omp target exit data map(release:stored_values)
9484# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9485#endif
9486# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9487 deallocate (stored_values)
9488# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9489#ifdef MFC_DEBUG
9490# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9491 block
9492# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9493 use iso_fortran_env, only: output_unit
9494# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9495
9496# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9497 print *, 'm_icpp_patches.fpp:707: ', '@:DEALLOCATE(x_coords)'
9498# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9499
9500# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9501 call flush (output_unit)
9502# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9503 end block
9504# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9505#endif
9506# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9507
9508# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9509#if defined(MFC_OpenACC)
9510# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9511!$acc exit data delete(x_coords)
9512# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9513#elif defined(MFC_OpenMP)
9514# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9515!$omp target exit data map(release:x_coords)
9516# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9517#endif
9518# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9519 deallocate (x_coords)
9520# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9521 end if
9522# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9523
9524# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9525 if (allocated(y_coords)) then
9526# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9527#ifdef MFC_DEBUG
9528# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9529 block
9530# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9531 use iso_fortran_env, only: output_unit
9532# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9533
9534# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9535 print *, 'm_icpp_patches.fpp:707: ', '@:DEALLOCATE(y_coords)'
9536# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9537
9538# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9539 call flush (output_unit)
9540# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9541 end block
9542# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9543#endif
9544# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9545
9546# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9547#if defined(MFC_OpenACC)
9548# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9549!$acc exit data delete(y_coords)
9550# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9551#elif defined(MFC_OpenMP)
9552# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9553!$omp target exit data map(release:y_coords)
9554# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9555#endif
9556# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9557 deallocate (y_coords)
9558# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9559 end if
9560
9561 end subroutine s_icpp_sweep_line
9562
9563 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
9564 !! Geometry of the patch is well-defined when its centroid are provided.
9565 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
9566
9567 integer, intent(in) :: patch_id
9568
9569#ifdef MFC_MIXED_PRECISION
9570 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9571#else
9572 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9573#endif
9574 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9575 integer :: i, j, k !< generic loop iterators
9576 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
9577 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
9578
9579 integer :: xRows, yRows, nRows, iix, iiy, max_files
9580# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9581 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9582# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9583 real(wp) :: x_len, x_step, y_len, y_step
9584# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9585 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9586# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9587 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
9588# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9589 real(wp) :: delta_x, delta_y
9590# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9591 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
9592# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9593 character(len=200) :: errmsg
9594# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9595 real(wp), allocatable :: stored_values(:,:,:)
9596# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9597 real(wp), allocatable :: x_coords(:), y_coords(:)
9598# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9599 logical :: files_loaded = .false.
9600# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9601 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9602# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9603 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
9604# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9605 character(len=20) :: file_num_str !< For storing the file number as a string
9606# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9607 character(len=20) :: zeros_part !< For the trailing zeros part
9608# 727 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9609 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
9610 ! Place any declaration of intermediate variables here
9611# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 real(wp) :: eps, eps_mhd, C_mhd
9613# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614 real(wp) :: r, rmax, gam, umax, p0
9615# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
9617# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618 real(wp) :: factor
9619# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620 real(wp) :: r0, alpha, r2
9621# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622 real(wp) :: sinA, cosA
9623# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624 real(wp) :: r_sq
9625# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626
9627# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628 ! # 207
9629# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630 real(wp) :: sigma, gauss1, gauss2
9631# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 ! # 208
9633# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
9635# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636
9637# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638 eps = 1.e-9_wp
9639
9640 pi_inf = pi_infs(1)
9641 gamma = gammas(1)
9642 lit_gamma = gs_min(1)
9643
9644 ! Transferring the patch's centroid and length information
9645 x_centroid = patch_icpp(patch_id)%x_centroid
9646 y_centroid = patch_icpp(patch_id)%y_centroid
9647 length_x = patch_icpp(patch_id)%length_x
9648 length_y = patch_icpp(patch_id)%length_y
9649
9650 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
9651 x_boundary%beg = x_centroid - 0.5_wp*length_x
9652 x_boundary%end = x_centroid + 0.5_wp*length_x
9653 y_boundary%beg = y_centroid - 0.5_wp*length_y
9654 y_boundary%end = y_centroid + 0.5_wp*length_y
9655
9656 ! Set eta=1 (no smoothing for this patch type)
9657 eta = 1._wp
9658 ! U0 is the characteristic velocity of the vortex
9659 u0 = patch_icpp(patch_id)%vel(1)
9660 ! L0 is the characteristic length of the vortex
9661 l0 = patch_icpp(patch_id)%vel(2)
9662 ! Assign patch vars if cell is covered and patch has write permission
9663 do j = 0, n
9664 do i = 0, m
9665 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
9666 & .and. y_boundary%end >= y_cc(j) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
9667 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
9668
9669
9670 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9671 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
9672# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9673 case (200) ! Two-fluid cubic interface
9674# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9675 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
9676# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9677 ! Volume Fractions
9678# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9679 q_prim_vf(advxb)%sf(i, j, 0) = eps
9680# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9681 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
9682# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9683 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
9684# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9685 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
9686# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9687 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
9688# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9689 end if
9690# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9691 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
9692# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9693 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
9694# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9695 rmax = 0.2_wp
9696# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9697
9698# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9699 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
9700# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9701 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
9702# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9703 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
9704# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9705
9706# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9707 if (r < rmax) then
9708# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9709 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
9710# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9711 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
9712# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9713 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
9714# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9715 else if (r < 2*rmax) then
9716# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9717 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
9718# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9719 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
9720# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9721 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
9722# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9723 else
9724# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9725 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
9726# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9727 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
9728# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9729 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
9730# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9731 end if
9732# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9733 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
9734# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9735 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
9736# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9737 rmax = 0.2_wp
9738# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9739
9740# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9741 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
9742# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9743 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
9744# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9745 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
9746# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9747
9748# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9749 if (r < rmax) then
9750# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9751 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
9752# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9753 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
9754# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9755 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
9756# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9757 else if (r < 2*rmax) then
9758# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9759 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
9760# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9761 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
9762# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9763 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
9764# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9765 else
9766# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9767 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
9768# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9769 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
9770# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9771 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
9772# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9773 end if
9774# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9775
9776# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9777 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
9778# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9779 case (204) ! Rayleigh-Taylor instability
9780# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9781 rhoh = 3._wp
9782# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9783 rhol = 1._wp
9784# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9785 pref = 1.e5_wp
9786# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9787 pint = pref
9788# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9789 h = 0.7_wp
9790# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9791 lam = 0.2_wp
9792# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9793 wl = 2._wp*pi/lam
9794# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9795 amp = 0.05_wp/wl
9796# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9797
9798# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9799 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
9800# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9801
9802# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9803 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9804# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9805
9806# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9807 if (alph < eps) alph = eps
9808# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9809 if (alph > 1._wp - eps) alph = 1._wp - eps
9810# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9811
9812# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9813 if (y_cc(j) > inth) then
9814# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9815 q_prim_vf(advxb)%sf(i, j, 0) = alph
9816# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9817 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
9818# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9819 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
9820# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9821 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
9822# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9823 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9824# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9825 else
9826# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9827 q_prim_vf(advxb)%sf(i, j, 0) = alph
9828# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9829 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
9830# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9831 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
9832# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9833 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
9834# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9835 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9836# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9837 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
9838# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9839 end if
9840# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9841 case (205) ! 2D lung wave interaction problem
9842# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9843 h = 0.0_wp ! non dim origin y
9844# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9845 lam = 1.0_wp ! non dim lambda
9846# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9847 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
9848# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9849
9850# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9851 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
9852# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9853
9854# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9855 if (y_cc(j) > inth) then
9856# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9857 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
9858# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9859 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
9860# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9861 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
9862# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9863 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
9864# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9865 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
9866# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9867 end if
9868# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9869 case (206) ! 2D lung wave interaction problem - horizontal domain
9870# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9871 h = 0.0_wp ! non dim origin y
9872# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9873 lam = 1.0_wp ! non dim lambda
9874# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9875 amp = patch_icpp(patch_id)%a(2)
9876# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9877
9878# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9879 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
9880# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9881
9882# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9883 if (x_cc(i) > intl) then ! this is the liquid
9884# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9885 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
9886# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9887 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
9888# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9889 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
9890# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9891 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
9892# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9893 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
9894# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9895 end if
9896# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9897 case (207) ! Kelvin Helmholtz Instability
9898# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9899 sigma = 0.05_wp/sqrt(2.0_wp)
9900# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9901 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
9902# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9903 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
9904# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9905 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
9906# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9907 case (208) ! Richtmeyer Meshkov Instability
9908# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9909 lam = 1.0_wp
9910# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9911 eps = 1.0e-6_wp
9912# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9913 ei = 5.0_wp
9914# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9915 ! Smoothening function to smooth out sharp discontinuity in the interface
9916# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9917 if (x_cc(i) <= 0.7_wp*lam) then
9918# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9919 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
9920# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9921 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
9922# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9923 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
9924# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9925 alpha_sf6 = 1.0_wp - alpha_air
9926# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9927 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
9928# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9929 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
9930# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9931 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
9932# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9933 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
9934# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9935 end if
9936# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9937 case (250) ! MHD Orszag-Tang vortex
9938# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9939 ! 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),
9940# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9941 ! sin(4*pi*x)/sqrt(4*pi), 0)
9942# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9943
9944# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9945 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
9946# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9947 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
9948# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9949
9950# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9951 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
9952# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9953 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
9954# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9955 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
9956# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9957 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
9958# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9959 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
9960# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9961 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
9962# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9963 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
9964# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9965 ! Linear interpolation between r=0.08 and r=1.0
9966# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9967 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
9968# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9969 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
9970# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9971 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
9972# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9973 else
9974# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9975 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
9976# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9977 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
9978# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9979 end if
9980# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9981
9982# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9983 ! case 252 is for the 2D MHD Rotor problem
9984# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9985 case (252) ! 2D MHD Rotor Problem
9986# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9987 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
9988# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9989 !
9990# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9991 ! 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
9992# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9993 ! velocity w=20, giving v_tan=2 at r=0.1
9994# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9995
9996# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9997 ! Calculate distance squared from the center
9998# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9999 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10000# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10001
10002# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10003 ! inner radius of 0.1
10004# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10005 if (r_sq <= 0.1**2) then
10006# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10007 ! -- Inside the rotor -- Set density uniformly to 10
10008# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10009 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
10010# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10011
10012# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10013 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
10014# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10015 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10016# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10017 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10018# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10019
10020# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10021 ! taper width of 0.015
10022# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10023 else if (r_sq <= 0.115**2) then
10024# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10025 ! linearly smooth the function between r = 0.1 and 0.115
10026# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10027 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10028# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10029
10030# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10031 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10032# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10033 q_prim_vf(momxb + 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)
10034# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10035 end if
10036# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10037 case (253) ! MHD Smooth Magnetic Vortex
10038# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10039 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
10040# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10041 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10042# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10043
10044# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10045 ! velocity
10046# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10047 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10048# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10049 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10050# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10051
10052# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10053 ! magnetic field
10054# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10055 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10056# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10057 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10058# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10059
10060# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10061 ! pressure
10062# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10063 q_prim_vf(e_idx)%sf(i, j, &
10064# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10065 & 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)
10066# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10067 case (260) ! Gaussian Divergence Pulse
10068# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10069 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
10070# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10071 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
10072# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10073 ! initialized to zero everywhere.
10074# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10075
10076# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10077 eps_mhd = patch_icpp(patch_id)%a(2)
10078# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10079 sigma = patch_icpp(patch_id)%a(3)
10080# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10081 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10082# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10083
10084# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10085 ! B-field
10086# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10087 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10088# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10089 case (261) ! Blob
10090# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10091 r0 = 1._wp/sqrt(8._wp)
10092# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10093 r2 = x_cc(i)**2 + y_cc(j)**2
10094# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10095 r = sqrt(r2)
10096# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10097 alpha = r/r0
10098# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10099 if (alpha < 1) then
10100# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10101 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
10102# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10103 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
10104# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10105 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) =
10106# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10107 ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
10108# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10109 end if
10110# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10111 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
10112# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10113 ! rotate by \alpha = atan(2)
10114# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10115 alpha = atan(2._wp)
10116# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10117 cosa = cos(alpha)
10118# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10119 sina = sin(alpha)
10120# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10121 ! projection along shock normal
10122# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10123 r = x_cc(i)*cosa + y_cc(j)*sina
10124# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10125
10126# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10127 if (r <= 0.5_wp) then
10128# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10129 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
10130# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10131 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10132# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10133 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
10134# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10135 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
10136# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10137 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
10138# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10139 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
10140# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10141 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
10142# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10143 else
10144# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10145 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
10146# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10147 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10148# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10149 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
10150# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10151 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
10152# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10153 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
10154# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10155 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
10156# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10157 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
10158# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10159 end if
10160# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10161 ! v^z and B^z remain zero by default
10162# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10163 case (270) ! 2D extrusion of 1D profile from external data
10164# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10165 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
10166# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10167 if (.not. files_loaded) then
10168# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10169 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
10170# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10171 do f = 1, max_files
10172# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10173 write (file_num_str, '(I0)') f
10174# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10175 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
10176# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10177 end do
10178# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10179
10180# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10181 ! Common file reading setup
10182# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10183 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10184# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10185 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
10186# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10187
10188# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10189 select case (num_dims)
10190# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10191 case (1, 2) ! 1D and 2D cases are similar
10192# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10193 ! Count lines
10194# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10195 line_count = 0
10196# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10197 do
10198# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10199 read (unit2, *, iostat=ios2) dummy_x, dummy_y
10200# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10201 if (ios2 /= 0) exit
10202# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10203 line_count = line_count + 1
10204# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10205 end do
10206# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10207 close (unit2)
10208# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10209
10210# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10211 xrows = line_count
10212# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10213 yrows = 1
10214# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10215 index_x = 0
10216# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10217 if (num_dims == 2) index_x = i
10218# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10219#ifdef MFC_DEBUG
10220# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10221 block
10222# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10223 use iso_fortran_env, only: output_unit
10224# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10225
10226# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10227 print *, 'm_icpp_patches.fpp:761: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
10228# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10229
10230# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10231 call flush (output_unit)
10232# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10233 end block
10234# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10235#endif
10236# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10237 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10238# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10239
10240# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10241
10242# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10243
10244# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10245#if defined(MFC_OpenACC)
10246# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10247!$acc enter data create(x_coords, stored_values)
10248# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10249#elif defined(MFC_OpenMP)
10250# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10251!$omp target enter data map(always,alloc:x_coords, stored_values)
10252# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10253#endif
10254# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10255
10256# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10257 ! Read data from all files
10258# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10259 do f = 1, max_files
10260# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10261 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10262# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10263 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10264# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10265
10266# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10267 do iter = 1, xrows
10268# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10269 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10270# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10271 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10272# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10273 end do
10274# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10275 close (unit)
10276# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10277 end do
10278# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10279
10280# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10281 ! Calculate offsets
10282# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10283 domain_xstart = x_coords(1)
10284# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10285 x_step = x_cc(1) - x_cc(0)
10286# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10287 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)
10288# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10289 global_offset_x = nint(abs(delta_x)/x_step)
10290# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10291 case (3) ! 3D case - determine grid structure
10292# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10293 ! Find yRows by counting rows with same x
10294# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10295 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10296# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10297 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10298# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10299
10300# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10301 yrows = 1
10302# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10303 do
10304# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10305 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10306# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10307 if (ios2 /= 0) exit
10308# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10309 if (dummy_x == x0 .and. dummy_y /= y0) then
10310# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10311 yrows = yrows + 1
10312# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10313 else
10314# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10315 exit
10316# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10317 end if
10318# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10319 end do
10320# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10321 close (unit2)
10322# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10323
10324# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10325 ! Count total rows
10326# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10327 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10328# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10329 nrows = 0
10330# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10331 do
10332# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10333 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10334# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10335 if (ios2 /= 0) exit
10336# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10337 nrows = nrows + 1
10338# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10339 end do
10340# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10341 close (unit2)
10342# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10343
10344# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10345 xrows = nrows/yrows
10346# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10347#ifdef MFC_DEBUG
10348# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10349 block
10350# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10351 use iso_fortran_env, only: output_unit
10352# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10353
10354# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10355 print *, 'm_icpp_patches.fpp:761: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
10356# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10357
10358# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10359 call flush (output_unit)
10360# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10361 end block
10362# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10363#endif
10364# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10365 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
10366# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10367
10368# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10369
10370# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10371
10372# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10373
10374# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10375#if defined(MFC_OpenACC)
10376# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10377!$acc enter data create(x_coords, y_coords, stored_values)
10378# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10379#elif defined(MFC_OpenMP)
10380# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10381!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
10382# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10383#endif
10384# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10385 index_x = i
10386# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10387 index_y = j
10388# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10389
10390# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10391 ! Read all files
10392# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10393 do f = 1, max_files
10394# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10395 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10396# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10397 if (ios /= 0) then
10398# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10399 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10400# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10401 cycle
10402# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10403 end if
10404# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10405
10406# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10407 iter = 0
10408# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10409 do iix = 1, xrows
10410# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10411 do iiy = 1, yrows
10412# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10413 iter = iter + 1
10414# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10415 if (f == 1) then
10416# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10417 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
10418# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10419 else
10420# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10421 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
10422# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10423 end if
10424# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10425 if (ios /= 0) call s_mpi_abort("Error reading data")
10426# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10427 end do
10428# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10429 end do
10430# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10431 close (unit)
10432# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10433 end do
10434# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10435
10436# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10437 ! Calculate offsets
10438# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10439 x_step = x_cc(1) - x_cc(0)
10440# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10441 y_step = y_cc(1) - y_cc(0)
10442# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10443 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
10444# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10445 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
10446# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10447 global_offset_x = nint(abs(delta_x)/x_step)
10448# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10449 global_offset_y = nint(abs(delta_y)/y_step)
10450# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10451 end select
10452# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10453
10454# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10455 files_loaded = .true.
10456# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10457 end if
10458# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10459
10460# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10461 ! Data assignment
10462# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10463 select case (num_dims)
10464# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10465 case (1)
10466# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10467 idx = i + 1 + global_offset_x
10468# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10469 do f = 1, sys_size
10470# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10471 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10472# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10473 end do
10474# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10475 case (2)
10476# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10477 idx = i + 1 + global_offset_x - index_x
10478# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10479 do f = 1, sys_size - 1
10480# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10481 jump = merge(1, 0, f >= momxe)
10482# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10483 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10484# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10485 end do
10486# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10487 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
10488# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10489 case (3)
10490# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10491 idx = i + 1 + global_offset_x - index_x
10492# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10493 idy = j + 1 + global_offset_y - index_y
10494# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10495 do f = 1, sys_size - 1
10496# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10497 jump = merge(1, 0, f >= momxe)
10498# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10499 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10500# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10501 end do
10502# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10503 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
10504# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10505 end select
10506# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10507 case (280) ! Isentropic vortex
10508# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10509 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
10510# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10511 ! geometry 2
10512# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10513 if (patch_id == 1) then
10514# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10515 q_prim_vf(e_idx)%sf(i, j, &
10516# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10517 & 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) &
10518# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10519 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
10520# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10521 q_prim_vf(contxb + 0)%sf(i, j, &
10522# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10523 & 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) &
10524# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10525 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
10526# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10527 q_prim_vf(momxb + 0)%sf(i, j, &
10528# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10529 & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
10530# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10531 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
10532# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10533 q_prim_vf(momxb + 1)%sf(i, j, &
10534# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10535 & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) &
10536# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10537 & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
10538# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10539 end if
10540# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10541 case (281) ! Acoustic pulse
10542# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10543 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
10544# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10545 ! geometry 2
10546# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10547 if (patch_id == 2) then
10548# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10549 q_prim_vf(e_idx)%sf(i, j, &
10550# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10551 & 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))
10552# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10553 q_prim_vf(contxb + 0)%sf(i, j, &
10554# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10555 & 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))
10556# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10557 end if
10558# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10559 case (282) ! Zero-circulation vortex
10560# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10561 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
10562# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10563 ! geometry 2
10564# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10565 if (patch_id == 2) then
10566# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10567 q_prim_vf(e_idx)%sf(i, j, &
10568# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10569 & 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))
10570# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10571 q_prim_vf(contxb + 0)%sf(i, j, &
10572# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10573 & 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))
10574# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10575 q_prim_vf(momxb + 0)%sf(i, j, &
10576# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10577 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
10578# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10579 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
10580# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10581 end if
10582# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10583 case default
10584# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10585 if (proc_rank == 0) then
10586# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10587 call s_int_to_str(patch_id, istr)
10588# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10589 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10590# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10591 end if
10592# 761 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10593 end select
10594 end if
10595
10596 ! Updating the patch identities bookkeeping variable
10597 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10598
10599 ! Assign Parameters
10600 q_prim_vf(mom_idx%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
10601 q_prim_vf(mom_idx%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
10602 q_prim_vf(e_idx)%sf(i, j, &
10603 & 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, &
10604 & 0)*u0*u0)/16
10605 end if
10606 end do
10607 end do
10608 if (allocated(stored_values)) then
10609# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10610#ifdef MFC_DEBUG
10611# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10612 block
10613# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10614 use iso_fortran_env, only: output_unit
10615# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10616
10617# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10618 print *, 'm_icpp_patches.fpp:776: ', '@:DEALLOCATE(stored_values)'
10619# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10620
10621# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10622 call flush (output_unit)
10623# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10624 end block
10625# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10626#endif
10627# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10628
10629# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10630#if defined(MFC_OpenACC)
10631# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10632!$acc exit data delete(stored_values)
10633# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10634#elif defined(MFC_OpenMP)
10635# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10636!$omp target exit data map(release:stored_values)
10637# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10638#endif
10639# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10640 deallocate (stored_values)
10641# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10642#ifdef MFC_DEBUG
10643# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10644 block
10645# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10646 use iso_fortran_env, only: output_unit
10647# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10648
10649# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10650 print *, 'm_icpp_patches.fpp:776: ', '@:DEALLOCATE(x_coords)'
10651# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10652
10653# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10654 call flush (output_unit)
10655# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10656 end block
10657# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10658#endif
10659# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10660
10661# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10662#if defined(MFC_OpenACC)
10663# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10664!$acc exit data delete(x_coords)
10665# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10666#elif defined(MFC_OpenMP)
10667# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10668!$omp target exit data map(release:x_coords)
10669# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10670#endif
10671# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10672 deallocate (x_coords)
10673# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10674 end if
10675# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10676
10677# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10678 if (allocated(y_coords)) then
10679# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10680#ifdef MFC_DEBUG
10681# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10682 block
10683# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10684 use iso_fortran_env, only: output_unit
10685# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10686
10687# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10688 print *, 'm_icpp_patches.fpp:776: ', '@:DEALLOCATE(y_coords)'
10689# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10690
10691# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10692 call flush (output_unit)
10693# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10694 end block
10695# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10696#endif
10697# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10698
10699# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10700#if defined(MFC_OpenACC)
10701# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10702!$acc exit data delete(y_coords)
10703# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10704#elif defined(MFC_OpenMP)
10705# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10706!$omp target exit data map(release:y_coords)
10707# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10708#endif
10709# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10710 deallocate (y_coords)
10711# 776 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10712 end if
10713
10714 end subroutine s_icpp_2d_taylorgreen_vortex
10715
10716 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
10717 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
10718
10719 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
10720
10721 ! Patch identifier
10722 integer, intent(in) :: patch_id
10723
10724#ifdef MFC_MIXED_PRECISION
10725 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10726#else
10727 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10728#endif
10729 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10730
10731 ! Generic loop iterators
10732 integer :: i, j, k
10733 ! Placeholders for the cell boundary values
10734 real(wp) :: pi_inf, gamma, lit_gamma
10735
10736 integer :: xRows, yRows, nRows, iix, iiy, max_files
10737# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10738 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10739# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10740 real(wp) :: x_len, x_step, y_len, y_step
10741# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10742 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10743# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10744 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
10745# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10746 real(wp) :: delta_x, delta_y
10747# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10748 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
10749# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10750 character(len=200) :: errmsg
10751# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10752 real(wp), allocatable :: stored_values(:,:,:)
10753# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10754 real(wp), allocatable :: x_coords(:), y_coords(:)
10755# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10756 logical :: files_loaded = .false.
10757# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10758 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10759# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10760 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
10761# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10762 character(len=20) :: file_num_str !< For storing the file number as a string
10763# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10764 character(len=20) :: zeros_part !< For the trailing zeros part
10765# 800 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10766 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
10767 ! Place any declaration of intermediate variables here
10768# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10769 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
10770
10771 pi_inf = pi_infs(1)
10772 gamma = gammas(1)
10773 lit_gamma = gs_min(1)
10774
10775 ! Transferring the patch's centroid and length information
10776 x_centroid = patch_icpp(patch_id)%x_centroid
10777 length_x = patch_icpp(patch_id)%length_x
10778
10779 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
10780 x_boundary%beg = x_centroid - 0.5_wp*length_x
10781 x_boundary%end = x_centroid + 0.5_wp*length_x
10782
10783 ! Set eta=1 (no smoothing for this patch type)
10784 eta = 1._wp
10785
10786 ! Assign patch vars if cell is covered and patch has write permission
10787 do i = 0, m
10788 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, &
10789 & 0, 0))) then
10790 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
10791
10792
10793 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10794 select case (patch_icpp(patch_id)%hcid)
10795# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10796 case (150) ! 1D Smooth Alfven Case for MHD
10797# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10798 ! velocity
10799# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10800 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
10801# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10802 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
10803# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10804
10805# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10806 ! magnetic field
10807# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10808 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
10809# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10810 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
10811# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10812 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
10813# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10814 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
10815# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10816 ! SDtoolbox)
10817# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10818 if (.not. files_loaded) then
10819# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10820 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
10821# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10822 do f = 1, max_files
10823# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10824 write (file_num_str, '(I0)') f
10825# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10826 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
10827# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10828 end do
10829# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10830
10831# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10832 ! Common file reading setup
10833# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10834 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10835# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10836 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
10837# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10838
10839# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10840 select case (num_dims)
10841# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10842 case (1, 2) ! 1D and 2D cases are similar
10843# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10844 ! Count lines
10845# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10846 line_count = 0
10847# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10848 do
10849# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10850 read (unit2, *, iostat=ios2) dummy_x, dummy_y
10851# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10852 if (ios2 /= 0) exit
10853# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10854 line_count = line_count + 1
10855# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10856 end do
10857# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10858 close (unit2)
10859# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10860
10861# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10862 xrows = line_count
10863# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10864 yrows = 1
10865# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10866 index_x = 0
10867# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10868 if (num_dims == 2) index_x = i
10869# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10870#ifdef MFC_DEBUG
10871# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10872 block
10873# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10874 use iso_fortran_env, only: output_unit
10875# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10876
10877# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10878 print *, 'm_icpp_patches.fpp:826: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
10879# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10880
10881# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10882 call flush (output_unit)
10883# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10884 end block
10885# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10886#endif
10887# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10888 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10889# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10890
10891# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10892
10893# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10894
10895# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10896#if defined(MFC_OpenACC)
10897# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10898!$acc enter data create(x_coords, stored_values)
10899# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10900#elif defined(MFC_OpenMP)
10901# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10902!$omp target enter data map(always,alloc:x_coords, stored_values)
10903# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10904#endif
10905# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10906
10907# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10908 ! Read data from all files
10909# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10910 do f = 1, max_files
10911# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10912 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10913# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10914 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10915# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10916
10917# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10918 do iter = 1, xrows
10919# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10920 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10921# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10922 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10923# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10924 end do
10925# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10926 close (unit)
10927# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10928 end do
10929# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10930
10931# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10932 ! Calculate offsets
10933# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10934 domain_xstart = x_coords(1)
10935# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10936 x_step = x_cc(1) - x_cc(0)
10937# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10938 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)
10939# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10940 global_offset_x = nint(abs(delta_x)/x_step)
10941# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10942 case (3) ! 3D case - determine grid structure
10943# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10944 ! Find yRows by counting rows with same x
10945# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10946 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10947# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10948 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10949# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10950
10951# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10952 yrows = 1
10953# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10954 do
10955# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10956 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10957# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10958 if (ios2 /= 0) exit
10959# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10960 if (dummy_x == x0 .and. dummy_y /= y0) then
10961# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10962 yrows = yrows + 1
10963# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10964 else
10965# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10966 exit
10967# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10968 end if
10969# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10970 end do
10971# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10972 close (unit2)
10973# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10974
10975# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10976 ! Count total rows
10977# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10978 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10979# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10980 nrows = 0
10981# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10982 do
10983# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10984 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10985# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10986 if (ios2 /= 0) exit
10987# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10988 nrows = nrows + 1
10989# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10990 end do
10991# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10992 close (unit2)
10993# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10994
10995# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10996 xrows = nrows/yrows
10997# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10998#ifdef MFC_DEBUG
10999# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11000 block
11001# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11002 use iso_fortran_env, only: output_unit
11003# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11004
11005# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11006 print *, 'm_icpp_patches.fpp:826: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11007# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11008
11009# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11010 call flush (output_unit)
11011# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11012 end block
11013# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11014#endif
11015# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11016 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11017# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11018
11019# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11020
11021# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11022
11023# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11024
11025# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11026#if defined(MFC_OpenACC)
11027# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11028!$acc enter data create(x_coords, y_coords, stored_values)
11029# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11030#elif defined(MFC_OpenMP)
11031# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11032!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11033# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11034#endif
11035# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11036 index_x = i
11037# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11038 index_y = j
11039# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11040
11041# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11042 ! Read all files
11043# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11044 do f = 1, max_files
11045# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11046 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11047# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11048 if (ios /= 0) then
11049# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11050 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11051# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11052 cycle
11053# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11054 end if
11055# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11056
11057# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11058 iter = 0
11059# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11060 do iix = 1, xrows
11061# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11062 do iiy = 1, yrows
11063# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11064 iter = iter + 1
11065# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11066 if (f == 1) then
11067# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11068 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11069# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11070 else
11071# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11072 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11073# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11074 end if
11075# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11076 if (ios /= 0) call s_mpi_abort("Error reading data")
11077# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11078 end do
11079# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11080 end do
11081# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11082 close (unit)
11083# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11084 end do
11085# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11086
11087# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11088 ! Calculate offsets
11089# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11090 x_step = x_cc(1) - x_cc(0)
11091# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11092 y_step = y_cc(1) - y_cc(0)
11093# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11094 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11095# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11096 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11097# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11098 global_offset_x = nint(abs(delta_x)/x_step)
11099# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11100 global_offset_y = nint(abs(delta_y)/y_step)
11101# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11102 end select
11103# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11104
11105# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11106 files_loaded = .true.
11107# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11108 end if
11109# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11110
11111# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11112 ! Data assignment
11113# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11114 select case (num_dims)
11115# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11116 case (1)
11117# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11118 idx = i + 1 + global_offset_x
11119# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11120 do f = 1, sys_size
11121# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11122 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11123# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11124 end do
11125# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11126 case (2)
11127# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11128 idx = i + 1 + global_offset_x - index_x
11129# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11130 do f = 1, sys_size - 1
11131# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11132 jump = merge(1, 0, f >= momxe)
11133# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11134 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11135# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11136 end do
11137# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11138 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
11139# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11140 case (3)
11141# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11142 idx = i + 1 + global_offset_x - index_x
11143# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11144 idy = j + 1 + global_offset_y - index_y
11145# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11146 do f = 1, sys_size - 1
11147# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11148 jump = merge(1, 0, f >= momxe)
11149# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11150 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11151# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11152 end do
11153# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11154 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
11155# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11156 end select
11157# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11158 case (180) ! Shu-Osher problem
11159# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11160 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
11161# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11162 ! 0.2*sin(5*x)"
11163# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11164 if (patch_id == 2) then
11165# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11166 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
11167# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11168 end if
11169# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11170 case (181) ! Titarev-Torro problem
11171# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11172 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
11173# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11174 ! "1 + 0.1*sin(20*x*pi)"
11175# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11176 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
11177# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11178 case (182) ! Multi-component diffusion
11179# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11180 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
11181# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11182 x_mid_diffu = 0.05_wp/2.0_wp
11183# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11184 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
11185# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11186 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
11187# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11188 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
11189# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11190 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
11191# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11192 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
11193# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11194
11195# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11196 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
11197# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11198 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
11199# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11200 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
11201# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11202 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
11203# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11204
11205# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11206 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
11207# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11208 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
11209# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11210 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
11211# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11212 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
11213# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11214
11215# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11216 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
11217# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11218
11219# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11220 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
11221# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11222
11223# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11224 q_prim_vf(contxb)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
11225# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11226 case default
11227# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11228 call s_int_to_str(patch_id, istr)
11229# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11230 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
11231# 826 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11232 end select
11233 end if
11234 end if
11235 end do
11236 if (allocated(stored_values)) then
11237# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11238#ifdef MFC_DEBUG
11239# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11240 block
11241# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11242 use iso_fortran_env, only: output_unit
11243# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11244
11245# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11246 print *, 'm_icpp_patches.fpp:830: ', '@:DEALLOCATE(stored_values)'
11247# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11248
11249# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11250 call flush (output_unit)
11251# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11252 end block
11253# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11254#endif
11255# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11256
11257# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11258#if defined(MFC_OpenACC)
11259# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11260!$acc exit data delete(stored_values)
11261# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11262#elif defined(MFC_OpenMP)
11263# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11264!$omp target exit data map(release:stored_values)
11265# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11266#endif
11267# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11268 deallocate (stored_values)
11269# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11270#ifdef MFC_DEBUG
11271# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11272 block
11273# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11274 use iso_fortran_env, only: output_unit
11275# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11276
11277# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11278 print *, 'm_icpp_patches.fpp:830: ', '@:DEALLOCATE(x_coords)'
11279# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11280
11281# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11282 call flush (output_unit)
11283# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11284 end block
11285# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11286#endif
11287# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11288
11289# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11290#if defined(MFC_OpenACC)
11291# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11292!$acc exit data delete(x_coords)
11293# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11294#elif defined(MFC_OpenMP)
11295# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11296!$omp target exit data map(release:x_coords)
11297# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11298#endif
11299# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11300 deallocate (x_coords)
11301# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11302 end if
11303# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11304
11305# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11306 if (allocated(y_coords)) then
11307# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11308#ifdef MFC_DEBUG
11309# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11310 block
11311# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11312 use iso_fortran_env, only: output_unit
11313# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11314
11315# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11316 print *, 'm_icpp_patches.fpp:830: ', '@:DEALLOCATE(y_coords)'
11317# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11318
11319# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11320 call flush (output_unit)
11321# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11322 end block
11323# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11324#endif
11325# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11326
11327# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11328#if defined(MFC_OpenACC)
11329# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11330!$acc exit data delete(y_coords)
11331# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11332#elif defined(MFC_OpenMP)
11333# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11334!$omp target exit data map(release:y_coords)
11335# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11336#endif
11337# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11338 deallocate (y_coords)
11339# 830 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11340 end if
11341
11342 end subroutine s_icpp_1d_bubble_pulse
11343
11344 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
11345 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
11346 !! 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);
11347 !! coefficients are relative (dimensionless).
11348 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
11349
11350 integer, intent(in) :: patch_id
11351
11352#ifdef MFC_MIXED_PRECISION
11353 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11354#else
11355 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11356#endif
11357 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11358 real(wp) :: r, theta, R_boundary, sum_series
11359 integer :: i, j, nn
11360
11361 x_centroid = patch_icpp(patch_id)%x_centroid
11362 y_centroid = patch_icpp(patch_id)%y_centroid
11363 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
11364 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
11365 eta = 1._wp
11366
11367 do j = 0, n
11368 do i = 0, m
11369 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
11370 if (r < small_radius) then
11371 theta = 0._wp
11372 else
11373 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
11374 end if
11375 sum_series = 0._wp
11376 do nn = 1, max_2d_fourier_modes
11377 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
11378 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
11379 end do
11380 if (patch_icpp(patch_id)%modal_use_exp_form) then
11381 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
11382 else
11383 r_boundary = patch_icpp(patch_id)%radius + sum_series
11384 r_boundary = max(r_boundary, 0._wp)
11385 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
11386 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
11387 end if
11388 end if
11389 if (patch_icpp(patch_id)%smoothen) then
11390 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy)*(r_boundary - r))
11391 end if
11392 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
11393 & 0) == smooth_patch_id) then
11394 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
11395 end if
11396 end do
11397 end do
11398
11399 end subroutine s_icpp_2d_modal
11400
11401 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
11402 !! atan2(y,x) relative to centroid.
11403 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
11404
11405 integer, intent(in) :: patch_id
11406
11407#ifdef MFC_MIXED_PRECISION
11408 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11409#else
11410 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11411#endif
11412 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11413 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
11414 integer :: i, j, k, ll, mm
11415
11416 x_centroid = patch_icpp(patch_id)%x_centroid
11417 y_centroid = patch_icpp(patch_id)%y_centroid
11418 z_centroid = patch_icpp(patch_id)%z_centroid
11419 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
11420 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
11421 eta_local = 1._wp
11422
11423 do k = 0, p
11424 do j = 0, n
11425 do i = 0, m
11426 if (grid_geometry == 3) then
11427 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
11428 dx_loc = x_cc(i) - x_centroid
11429 dy_loc = cart_y - y_centroid
11430 dz_loc = cart_z - z_centroid
11431 else
11432 dx_loc = x_cc(i) - x_centroid
11433 dy_loc = y_cc(j) - y_centroid
11434 dz_loc = z_cc(k) - z_centroid
11435 end if
11436 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
11437 if (r < small_radius) then
11438 theta = 0._wp
11439 phi = 0._wp
11440 else
11441 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
11442 phi = atan2(dy_loc, dx_loc)
11443 end if
11444 r_surface = patch_icpp(patch_id)%radius
11445 do ll = 0, max_sph_harm_degree
11446 do mm = -ll, ll
11447 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
11448 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
11449 end do
11450 end do
11451 if (patch_icpp(patch_id)%smoothen) then
11452 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy, dz)*(r_surface - r))
11453 end if
11454 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
11455 & k) == smooth_patch_id) then
11456 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
11457 end if
11458 end do
11459 end do
11460 end do
11461
11462 end subroutine s_icpp_3d_spherical_harmonic
11463
11464 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
11465 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
11466 !! its boundary.
11467 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
11468
11469 integer, intent(in) :: patch_id
11470
11471#ifdef MFC_MIXED_PRECISION
11472 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11473#else
11474 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11475#endif
11476 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11477
11478 ! Generic loop iterators
11479 integer :: i, j, k
11480 real(wp) :: radius
11481
11482 integer :: xRows, yRows, nRows, iix, iiy, max_files
11483# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11484 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11485# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11486 real(wp) :: x_len, x_step, y_len, y_step
11487# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11488 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11489# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11490 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
11491# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11492 real(wp) :: delta_x, delta_y
11493# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11494 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
11495# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11496 character(len=200) :: errmsg
11497# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11498 real(wp), allocatable :: stored_values(:,:,:)
11499# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11500 real(wp), allocatable :: x_coords(:), y_coords(:)
11501# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11502 logical :: files_loaded = .false.
11503# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11504 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11505# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11506 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
11507# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11508 character(len=20) :: file_num_str !< For storing the file number as a string
11509# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11510 character(len=20) :: zeros_part !< For the trailing zeros part
11511# 972 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11512 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
11513 ! Place any declaration of intermediate variables here
11514# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11515 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
11516# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11517 real(wp) :: eps
11518# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11519
11520# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11521 ! IGR Jets Arrays to stor position and radii of jets from input file
11522# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11523 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
11524# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11525 ! Variables to describe initial condition of jet
11526# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11527 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
11528# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11529 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
11530# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11531 real(wp), dimension(0:n,0:p) :: rcut_arr
11532# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11533 integer :: l, q, s !< Iterators for reading input files
11534# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11535 integer :: start, end !< Ints to keep track of position in file
11536# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11537 character(len=1000) :: line !< String to store line in file
11538# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11539 character(len=25) :: value !< String to store value in line
11540# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11541 integer :: NJet !< Number of jets
11542# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11543
11544# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11545 eps = 1e-9_wp
11546# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11547
11548# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11549 if (patch_icpp(patch_id)%hcid == 303) then
11550# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11551 eps_smooth = 3._wp
11552# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11553 open (unit=10, file="njet.txt", status="old", action="read")
11554# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11555 read (10, *) njet
11556# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11557 close (10)
11558# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11559
11560# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11561 allocate (y_th_arr(0:njet - 1))
11562# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11563 allocate (z_th_arr(0:njet - 1))
11564# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11565 allocate (r_th_arr(0:njet - 1))
11566# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11567
11568# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11569 open (unit=10, file="jets.csv", status="old", action="read")
11570# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11571 do q = 0, njet - 1
11572# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11573 read (10, '(A)') line ! Read a full line as a string
11574# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11575 start = 1
11576# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11577
11578# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11579 do l = 0, 2
11580# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11581 end = index(line(start:), ',') ! Find the next comma
11582# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11583 if (end == 0) then
11584# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11585 value = trim(adjustl(line(start:))) ! Last value in the line
11586# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11587 else
11588# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11589 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
11590# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11591 start = start + end ! Move to next value
11592# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11593 end if
11594# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11595 if (l == 0) then
11596# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11597 read (value, *) y_th_arr(q) ! Convert string to numeric value
11598# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11599 else if (l == 1) then
11600# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11601 read (value, *) z_th_arr(q)
11602# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11603 else
11604# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11605 read (value, *) r_th_arr(q)
11606# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11607 end if
11608# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11609 end do
11610# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11611 end do
11612# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11613 close (10)
11614# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11615
11616# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11617 do q = 0, p
11618# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11619 do l = 0, n
11620# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11621 rcut = 0._wp
11622# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11623 do s = 0, njet - 1
11624# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11625 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
11626# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11627 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
11628# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11629 end do
11630# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11631 rcut_arr(l, q) = rcut
11632# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11633 end do
11634# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11635 end do
11636# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11637 end if
11638
11639 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
11640
11641 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
11642 x_centroid = patch_icpp(patch_id)%x_centroid
11643 y_centroid = patch_icpp(patch_id)%y_centroid
11644 z_centroid = patch_icpp(patch_id)%z_centroid
11645 radius = patch_icpp(patch_id)%radius
11646 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
11647 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
11648
11649 ! Initialize eta=1; modified if smoothing is enabled
11650 eta = 1._wp
11651
11652 ! Assign patch vars if cell is covered and patch has write permission
11653 do k = 0, p
11654 do j = 0, n
11655 do i = 0, m
11656 if (grid_geometry == 3) then
11657 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
11658 else
11659 cart_y = y_cc(j)
11660 cart_z = z_cc(k)
11661 end if
11662
11663 if (patch_icpp(patch_id)%smoothen) then
11664 eta = tanh(smooth_coeff/min(dx, dy, &
11665 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) &
11666 & - radius))*(-0.5_wp) + 0.5_wp
11667 end if
11668
11669 if ((((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2) &
11670 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
11671 & k) == smooth_patch_id) then
11672 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
11673
11674
11675 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11676 select case (patch_icpp(patch_id)%hcid)
11677# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678 case (300) ! Rayleigh-Taylor instability
11679# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680 rhoh = 3._wp
11681# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682 rhol = 1._wp
11683# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 pref = 1.e5_wp
11685# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686 pint = pref
11687# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688 h = 0.7_wp
11689# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690 lam = 0.2_wp
11691# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692 wl = 2._wp*pi/lam
11693# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694 amp = 0.025_wp/wl
11695# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696
11697# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698 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
11699# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700
11701# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
11703# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704
11705# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706 if (alph < eps) alph = eps
11707# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708 if (alph > 1._wp - eps) alph = 1._wp - eps
11709# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710
11711# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712 if (y_cc(j) > inth) then
11713# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714 q_prim_vf(advxb)%sf(i, j, k) = alph
11715# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
11717# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
11719# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
11721# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
11723# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11724 else
11725# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11726 q_prim_vf(advxb)%sf(i, j, k) = alph
11727# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11728 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
11729# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11730 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
11731# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11732 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
11733# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11734 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
11735# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11736 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
11737# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11738 end if
11739# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11740 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
11741# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11742 h = 0.0_wp
11743# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11744 lam = 1.0_wp
11745# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11746 amp = patch_icpp(patch_id)%a(2)
11747# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11748 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
11749# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750 if (x_cc(i) > inth) then
11751# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
11753# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
11755# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
11757# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
11759# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
11761# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762 end if
11763# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764 case (302) ! 3D Jet with IGR
11765# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766 ux_th = 10*sqrt(1.4*0.4)
11767# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 ux_am = 0.0*sqrt(1.4)
11769# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770 p_th = 2.0_wp
11771# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 p_am = 1.0_wp
11773# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 rho_th = 1._wp
11775# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 rho_am = 1._wp
11777# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11778 y_th = 0.0_wp
11779# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11780 z_th = 0.0_wp
11781# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11782 r_th = 1._wp
11783# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11784 eps_smooth = 1._wp
11785# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11786 eps = 1e-6
11787# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11788
11789# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11790 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
11791# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11792 rcut = f_cut_on(r - r_th, eps_smooth)
11793# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11794 xcut = f_cut_on(x_cc(i), eps_smooth)
11795# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11796
11797# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11798 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
11799# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11800 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
11801# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11802 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
11803# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11804
11805# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11806 if (num_fluids == 1) then
11807# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
11809# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 else
11811# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
11813# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
11815# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
11817# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 end if
11819# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820
11821# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
11823# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 case (303) ! 3D Multijet
11825# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 eps_smooth = 3.0_wp
11827# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 ux_th = 10*sqrt(1.4*0.4)
11829# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830 ux_am = 2.5*sqrt(1.4*0.4)
11831# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 p_th = 0.8_wp
11833# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834 p_am = 0.4_wp
11835# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836 rho_th = 1._wp
11837# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 rho_am = 1._wp
11839# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840 eps = 1e-6
11841# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842
11843# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844 rcut = rcut_arr(j, k)
11845# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 xcut = f_cut_on(x_cc(i), eps_smooth)
11847# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848
11849# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
11851# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
11853# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
11855# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856
11857# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 if (num_fluids == 1) then
11859# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
11861# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 else
11863# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
11865# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
11867# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
11869# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870 end if
11871# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872
11873# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
11875# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876 case (370) ! 3D extrusion of 2D profile from external data
11877# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
11879# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880 if (.not. files_loaded) then
11881# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11883# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884 do f = 1, max_files
11885# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886 write (file_num_str, '(I0)') f
11887# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11889# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890 end do
11891# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892
11893# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 ! Common file reading setup
11895# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11897# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11899# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900
11901# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902 select case (num_dims)
11903# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904 case (1, 2) ! 1D and 2D cases are similar
11905# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906 ! Count lines
11907# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908 line_count = 0
11909# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910 do
11911# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11913# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914 if (ios2 /= 0) exit
11915# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916 line_count = line_count + 1
11917# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918 end do
11919# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 close (unit2)
11921# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922
11923# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 xrows = line_count
11925# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926 yrows = 1
11927# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928 index_x = 0
11929# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930 if (num_dims == 2) index_x = i
11931# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932#ifdef MFC_DEBUG
11933# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934 block
11935# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 use iso_fortran_env, only: output_unit
11937# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938
11939# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940 print *, 'm_icpp_patches.fpp:1012: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11941# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942
11943# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 call flush (output_unit)
11945# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 end block
11947# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948#endif
11949# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11951# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952
11953# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954
11955# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956
11957# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958#if defined(MFC_OpenACC)
11959# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960!$acc enter data create(x_coords, stored_values)
11961# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962#elif defined(MFC_OpenMP)
11963# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964!$omp target enter data map(always,alloc:x_coords, stored_values)
11965# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966#endif
11967# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968
11969# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 ! Read data from all files
11971# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972 do f = 1, max_files
11973# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11975# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11977# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978
11979# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980 do iter = 1, xrows
11981# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11983# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11984 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11985# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11986 end do
11987# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11988 close (unit)
11989# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11990 end do
11991# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11992
11993# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11994 ! Calculate offsets
11995# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11996 domain_xstart = x_coords(1)
11997# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11998 x_step = x_cc(1) - x_cc(0)
11999# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12000 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)
12001# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12002 global_offset_x = nint(abs(delta_x)/x_step)
12003# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12004 case (3) ! 3D case - determine grid structure
12005# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12006 ! Find yRows by counting rows with same x
12007# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12008 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12009# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12010 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12011# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12012
12013# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12014 yrows = 1
12015# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12016 do
12017# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12018 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12019# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12020 if (ios2 /= 0) exit
12021# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12022 if (dummy_x == x0 .and. dummy_y /= y0) then
12023# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12024 yrows = yrows + 1
12025# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12026 else
12027# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12028 exit
12029# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12030 end if
12031# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12032 end do
12033# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12034 close (unit2)
12035# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12036
12037# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12038 ! Count total rows
12039# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12040 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12041# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12042 nrows = 0
12043# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12044 do
12045# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12046 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12047# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12048 if (ios2 /= 0) exit
12049# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12050 nrows = nrows + 1
12051# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12052 end do
12053# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12054 close (unit2)
12055# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12056
12057# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12058 xrows = nrows/yrows
12059# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12060#ifdef MFC_DEBUG
12061# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12062 block
12063# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12064 use iso_fortran_env, only: output_unit
12065# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12066
12067# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12068 print *, 'm_icpp_patches.fpp:1012: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12069# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12070
12071# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12072 call flush (output_unit)
12073# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12074 end block
12075# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12076#endif
12077# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12078 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12079# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12080
12081# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12082
12083# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12084
12085# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12086
12087# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12088#if defined(MFC_OpenACC)
12089# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12090!$acc enter data create(x_coords, y_coords, stored_values)
12091# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12092#elif defined(MFC_OpenMP)
12093# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12094!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12095# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12096#endif
12097# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12098 index_x = i
12099# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12100 index_y = j
12101# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12102
12103# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12104 ! Read all files
12105# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12106 do f = 1, max_files
12107# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12108 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12109# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12110 if (ios /= 0) then
12111# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12112 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12113# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12114 cycle
12115# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12116 end if
12117# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12118
12119# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12120 iter = 0
12121# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12122 do iix = 1, xrows
12123# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12124 do iiy = 1, yrows
12125# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12126 iter = iter + 1
12127# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12128 if (f == 1) then
12129# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12130 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12131# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12132 else
12133# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12134 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12135# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12136 end if
12137# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12138 if (ios /= 0) call s_mpi_abort("Error reading data")
12139# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12140 end do
12141# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12142 end do
12143# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12144 close (unit)
12145# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12146 end do
12147# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12148
12149# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12150 ! Calculate offsets
12151# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12152 x_step = x_cc(1) - x_cc(0)
12153# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12154 y_step = y_cc(1) - y_cc(0)
12155# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12156 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12157# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12158 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12159# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12160 global_offset_x = nint(abs(delta_x)/x_step)
12161# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12162 global_offset_y = nint(abs(delta_y)/y_step)
12163# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12164 end select
12165# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12166
12167# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12168 files_loaded = .true.
12169# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12170 end if
12171# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12172
12173# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12174 ! Data assignment
12175# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12176 select case (num_dims)
12177# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12178 case (1)
12179# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12180 idx = i + 1 + global_offset_x
12181# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12182 do f = 1, sys_size
12183# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12184 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12185# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12186 end do
12187# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12188 case (2)
12189# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12190 idx = i + 1 + global_offset_x - index_x
12191# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12192 do f = 1, sys_size - 1
12193# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12194 jump = merge(1, 0, f >= momxe)
12195# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12196 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12197# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12198 end do
12199# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12200 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
12201# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12202 case (3)
12203# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12204 idx = i + 1 + global_offset_x - index_x
12205# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12206 idy = j + 1 + global_offset_y - index_y
12207# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12208 do f = 1, sys_size - 1
12209# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12210 jump = merge(1, 0, f >= momxe)
12211# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12212 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12213# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12214 end do
12215# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12216 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
12217# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12218 end select
12219# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12220 case (380) ! Taylor-Green vortex
12221# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12222 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
12223# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12224 ! geometry 9
12225# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12226 mach = 0.1
12227# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12228 if (patch_id == 1) then
12229# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12230 q_prim_vf(e_idx)%sf(i, j, &
12231# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12232 & 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)
12233# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12234 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
12235# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12236 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
12237# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12238 end if
12239# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12240 case default
12241# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12242 call s_int_to_str(patch_id, istr)
12243# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12244 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
12245# 1012 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12246 end select
12247 end if
12248 end if
12249 end do
12250 end do
12251 end do
12252 if (allocated(stored_values)) then
12253# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12254#ifdef MFC_DEBUG
12255# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12256 block
12257# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12258 use iso_fortran_env, only: output_unit
12259# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12260
12261# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 print *, 'm_icpp_patches.fpp:1018: ', '@:DEALLOCATE(stored_values)'
12263# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12264
12265# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12266 call flush (output_unit)
12267# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12268 end block
12269# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12270#endif
12271# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12272
12273# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12274#if defined(MFC_OpenACC)
12275# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12276!$acc exit data delete(stored_values)
12277# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12278#elif defined(MFC_OpenMP)
12279# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12280!$omp target exit data map(release:stored_values)
12281# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12282#endif
12283# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12284 deallocate (stored_values)
12285# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12286#ifdef MFC_DEBUG
12287# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12288 block
12289# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12290 use iso_fortran_env, only: output_unit
12291# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12292
12293# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12294 print *, 'm_icpp_patches.fpp:1018: ', '@:DEALLOCATE(x_coords)'
12295# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12296
12297# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12298 call flush (output_unit)
12299# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12300 end block
12301# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12302#endif
12303# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12304
12305# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12306#if defined(MFC_OpenACC)
12307# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12308!$acc exit data delete(x_coords)
12309# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12310#elif defined(MFC_OpenMP)
12311# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12312!$omp target exit data map(release:x_coords)
12313# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12314#endif
12315# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12316 deallocate (x_coords)
12317# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12318 end if
12319# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12320
12321# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12322 if (allocated(y_coords)) then
12323# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12324#ifdef MFC_DEBUG
12325# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12326 block
12327# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12328 use iso_fortran_env, only: output_unit
12329# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12330
12331# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12332 print *, 'm_icpp_patches.fpp:1018: ', '@:DEALLOCATE(y_coords)'
12333# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12334
12335# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12336 call flush (output_unit)
12337# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12338 end block
12339# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12340#endif
12341# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12342
12343# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12344#if defined(MFC_OpenACC)
12345# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12346!$acc exit data delete(y_coords)
12347# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12348#elif defined(MFC_OpenMP)
12349# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12350!$omp target exit data map(release:y_coords)
12351# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12352#endif
12353# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12354 deallocate (y_coords)
12355# 1018 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12356 end if
12357
12358 end subroutine s_icpp_sphere
12359
12360 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
12361 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
12362 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
12363 !! allow for the smearing of its boundaries.
12364 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
12365
12366 integer, intent(in) :: patch_id
12367
12368#ifdef MFC_MIXED_PRECISION
12369 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12370#else
12371 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12372#endif
12373 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12374 integer :: i, j, k !< Generic loop iterators
12375
12376 integer :: xRows, yRows, nRows, iix, iiy, max_files
12377# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12378 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12379# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12380 real(wp) :: x_len, x_step, y_len, y_step
12381# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12382 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12383# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12384 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
12385# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12386 real(wp) :: delta_x, delta_y
12387# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12388 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
12389# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12390 character(len=200) :: errmsg
12391# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12392 real(wp), allocatable :: stored_values(:,:,:)
12393# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12394 real(wp), allocatable :: x_coords(:), y_coords(:)
12395# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12396 logical :: files_loaded = .false.
12397# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12398 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12399# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12400 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
12401# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12402 character(len=20) :: file_num_str !< For storing the file number as a string
12403# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12404 character(len=20) :: zeros_part !< For the trailing zeros part
12405# 1038 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12406 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
12407 ! Place any declaration of intermediate variables here
12408# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12409 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12410# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12411 real(wp) :: eps
12412# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12413
12414# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12415 ! IGR Jets Arrays to stor position and radii of jets from input file
12416# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12417 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12418# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12419 ! Variables to describe initial condition of jet
12420# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12421 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12422# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12423 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
12424# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12425 real(wp), dimension(0:n,0:p) :: rcut_arr
12426# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12427 integer :: l, q, s !< Iterators for reading input files
12428# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12429 integer :: start, end !< Ints to keep track of position in file
12430# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12431 character(len=1000) :: line !< String to store line in file
12432# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12433 character(len=25) :: value !< String to store value in line
12434# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12435 integer :: NJet !< Number of jets
12436# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12437
12438# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12439 eps = 1e-9_wp
12440# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12441
12442# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12443 if (patch_icpp(patch_id)%hcid == 303) then
12444# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12445 eps_smooth = 3._wp
12446# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12447 open (unit=10, file="njet.txt", status="old", action="read")
12448# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12449 read (10, *) njet
12450# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12451 close (10)
12452# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12453
12454# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12455 allocate (y_th_arr(0:njet - 1))
12456# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12457 allocate (z_th_arr(0:njet - 1))
12458# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12459 allocate (r_th_arr(0:njet - 1))
12460# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12461
12462# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12463 open (unit=10, file="jets.csv", status="old", action="read")
12464# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12465 do q = 0, njet - 1
12466# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12467 read (10, '(A)') line ! Read a full line as a string
12468# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12469 start = 1
12470# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12471
12472# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12473 do l = 0, 2
12474# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12475 end = index(line(start:), ',') ! Find the next comma
12476# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12477 if (end == 0) then
12478# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12479 value = trim(adjustl(line(start:))) ! Last value in the line
12480# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12481 else
12482# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12483 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12484# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12485 start = start + end ! Move to next value
12486# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12487 end if
12488# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12489 if (l == 0) then
12490# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12491 read (value, *) y_th_arr(q) ! Convert string to numeric value
12492# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12493 else if (l == 1) then
12494# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12495 read (value, *) z_th_arr(q)
12496# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12497 else
12498# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12499 read (value, *) r_th_arr(q)
12500# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12501 end if
12502# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12503 end do
12504# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12505 end do
12506# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12507 close (10)
12508# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12509
12510# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12511 do q = 0, p
12512# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12513 do l = 0, n
12514# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12515 rcut = 0._wp
12516# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12517 do s = 0, njet - 1
12518# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12519 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12520# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12521 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12522# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12523 end do
12524# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12525 rcut_arr(l, q) = rcut
12526# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12527 end do
12528# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12529 end do
12530# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12531 end if
12532
12533 ! Transferring the cuboid's centroid and length information
12534 x_centroid = patch_icpp(patch_id)%x_centroid
12535 y_centroid = patch_icpp(patch_id)%y_centroid
12536 z_centroid = patch_icpp(patch_id)%z_centroid
12537 length_x = patch_icpp(patch_id)%length_x
12538 length_y = patch_icpp(patch_id)%length_y
12539 length_z = patch_icpp(patch_id)%length_z
12540
12541 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
12542 x_boundary%beg = x_centroid - 0.5_wp*length_x
12543 x_boundary%end = x_centroid + 0.5_wp*length_x
12544 y_boundary%beg = y_centroid - 0.5_wp*length_y
12545 y_boundary%end = y_centroid + 0.5_wp*length_y
12546 z_boundary%beg = z_centroid - 0.5_wp*length_z
12547 z_boundary%end = z_centroid + 0.5_wp*length_z
12548
12549 ! Set eta=1 (no smoothing for this patch type)
12550 eta = 1._wp
12551
12552 ! Assign patch vars if cell is covered and patch has write permission
12553 do k = 0, p
12554 do j = 0, n
12555 do i = 0, m
12556 if (grid_geometry == 3) then
12557 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12558 else
12559 cart_y = y_cc(j)
12560 cart_z = z_cc(k)
12561 end if
12562
12563 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) &
12564 & .and. y_boundary%beg <= cart_y .and. y_boundary%end >= cart_y .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) then
12565 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
12566 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
12567
12568
12569 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12570 select case (patch_icpp(patch_id)%hcid)
12571# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12572 case (300) ! Rayleigh-Taylor instability
12573# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12574 rhoh = 3._wp
12575# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12576 rhol = 1._wp
12577# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12578 pref = 1.e5_wp
12579# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12580 pint = pref
12581# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12582 h = 0.7_wp
12583# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12584 lam = 0.2_wp
12585# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12586 wl = 2._wp*pi/lam
12587# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12588 amp = 0.025_wp/wl
12589# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12590
12591# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12592 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
12593# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12594
12595# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12596 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12597# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12598
12599# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12600 if (alph < eps) alph = eps
12601# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12602 if (alph > 1._wp - eps) alph = 1._wp - eps
12603# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12604
12605# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12606 if (y_cc(j) > inth) then
12607# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12608 q_prim_vf(advxb)%sf(i, j, k) = alph
12609# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12610 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12611# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12612 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12613# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12614 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12615# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12616 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12617# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12618 else
12619# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12620 q_prim_vf(advxb)%sf(i, j, k) = alph
12621# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12622 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12623# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12624 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12625# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12626 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12627# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12628 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12629# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12630 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12631# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12632 end if
12633# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12634 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12635# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12636 h = 0.0_wp
12637# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12638 lam = 1.0_wp
12639# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12640 amp = patch_icpp(patch_id)%a(2)
12641# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12642 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12643# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12644 if (x_cc(i) > inth) then
12645# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12646 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12647# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12648 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12649# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12650 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
12651# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12652 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12653# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12654 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12655# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12656 end if
12657# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12658 case (302) ! 3D Jet with IGR
12659# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12660 ux_th = 10*sqrt(1.4*0.4)
12661# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12662 ux_am = 0.0*sqrt(1.4)
12663# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12664 p_th = 2.0_wp
12665# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12666 p_am = 1.0_wp
12667# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12668 rho_th = 1._wp
12669# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12670 rho_am = 1._wp
12671# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12672 y_th = 0.0_wp
12673# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12674 z_th = 0.0_wp
12675# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12676 r_th = 1._wp
12677# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12678 eps_smooth = 1._wp
12679# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12680 eps = 1e-6
12681# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12682
12683# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12684 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12685# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12686 rcut = f_cut_on(r - r_th, eps_smooth)
12687# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12688 xcut = f_cut_on(x_cc(i), eps_smooth)
12689# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12690
12691# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12692 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12693# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12694 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12695# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12696 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12697# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12698
12699# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12700 if (num_fluids == 1) then
12701# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12702 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12703# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12704 else
12705# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12706 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12707# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12708 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12709# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12710 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12711# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12712 end if
12713# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12714
12715# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12716 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12717# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 case (303) ! 3D Multijet
12719# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 eps_smooth = 3.0_wp
12721# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722 ux_th = 10*sqrt(1.4*0.4)
12723# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 ux_am = 2.5*sqrt(1.4*0.4)
12725# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726 p_th = 0.8_wp
12727# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 p_am = 0.4_wp
12729# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 rho_th = 1._wp
12731# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732 rho_am = 1._wp
12733# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734 eps = 1e-6
12735# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736
12737# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738 rcut = rcut_arr(j, k)
12739# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740 xcut = f_cut_on(x_cc(i), eps_smooth)
12741# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742
12743# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12745# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12747# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12749# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750
12751# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752 if (num_fluids == 1) then
12753# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12755# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 else
12757# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12759# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12761# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12763# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764 end if
12765# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766
12767# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12769# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770 case (370) ! 3D extrusion of 2D profile from external data
12771# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12773# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774 if (.not. files_loaded) then
12775# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12777# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778 do f = 1, max_files
12779# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780 write (file_num_str, '(I0)') f
12781# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
12783# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 end do
12785# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786
12787# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 ! Common file reading setup
12789# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12791# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12793# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794
12795# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 select case (num_dims)
12797# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 case (1, 2) ! 1D and 2D cases are similar
12799# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800 ! Count lines
12801# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802 line_count = 0
12803# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804 do
12805# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12807# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808 if (ios2 /= 0) exit
12809# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 line_count = line_count + 1
12811# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812 end do
12813# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 close (unit2)
12815# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816
12817# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818 xrows = line_count
12819# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 yrows = 1
12821# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822 index_x = 0
12823# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824 if (num_dims == 2) index_x = i
12825# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826#ifdef MFC_DEBUG
12827# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828 block
12829# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830 use iso_fortran_env, only: output_unit
12831# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832
12833# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834 print *, 'm_icpp_patches.fpp:1078: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12835# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836
12837# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838 call flush (output_unit)
12839# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 end block
12841# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842#endif
12843# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12845# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846
12847# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848
12849# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850
12851# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852#if defined(MFC_OpenACC)
12853# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854!$acc enter data create(x_coords, stored_values)
12855# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856#elif defined(MFC_OpenMP)
12857# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858!$omp target enter data map(always,alloc:x_coords, stored_values)
12859# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860#endif
12861# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862
12863# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864 ! Read data from all files
12865# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 do f = 1, max_files
12867# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12869# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12871# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872
12873# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874 do iter = 1, xrows
12875# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12877# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
12879# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880 end do
12881# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882 close (unit)
12883# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884 end do
12885# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886
12887# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888 ! Calculate offsets
12889# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890 domain_xstart = x_coords(1)
12891# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892 x_step = x_cc(1) - x_cc(0)
12893# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894 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)
12895# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896 global_offset_x = nint(abs(delta_x)/x_step)
12897# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898 case (3) ! 3D case - determine grid structure
12899# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900 ! Find yRows by counting rows with same x
12901# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12903# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12905# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906
12907# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908 yrows = 1
12909# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910 do
12911# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12913# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 if (ios2 /= 0) exit
12915# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 if (dummy_x == x0 .and. dummy_y /= y0) then
12917# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918 yrows = yrows + 1
12919# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 else
12921# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 exit
12923# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 end if
12925# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926 end do
12927# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 close (unit2)
12929# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930
12931# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932 ! Count total rows
12933# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12934 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12935# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936 nrows = 0
12937# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938 do
12939# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12941# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 if (ios2 /= 0) exit
12943# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 nrows = nrows + 1
12945# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946 end do
12947# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 close (unit2)
12949# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950
12951# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952 xrows = nrows/yrows
12953# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954#ifdef MFC_DEBUG
12955# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956 block
12957# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958 use iso_fortran_env, only: output_unit
12959# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960
12961# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962 print *, 'm_icpp_patches.fpp:1078: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12963# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964
12965# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966 call flush (output_unit)
12967# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 end block
12969# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970#endif
12971# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12973# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974
12975# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976
12977# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978
12979# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980
12981# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982#if defined(MFC_OpenACC)
12983# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984!$acc enter data create(x_coords, y_coords, stored_values)
12985# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986#elif defined(MFC_OpenMP)
12987# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12989# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990#endif
12991# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992 index_x = i
12993# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994 index_y = j
12995# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996
12997# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998 ! Read all files
12999# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000 do f = 1, max_files
13001# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13003# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004 if (ios /= 0) then
13005# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13007# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008 cycle
13009# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 end if
13011# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012
13013# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 iter = 0
13015# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016 do iix = 1, xrows
13017# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018 do iiy = 1, yrows
13019# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020 iter = iter + 1
13021# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 if (f == 1) then
13023# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13025# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 else
13027# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13029# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030 end if
13031# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032 if (ios /= 0) call s_mpi_abort("Error reading data")
13033# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034 end do
13035# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036 end do
13037# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 close (unit)
13039# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040 end do
13041# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042
13043# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044 ! Calculate offsets
13045# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13046 x_step = x_cc(1) - x_cc(0)
13047# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13048 y_step = y_cc(1) - y_cc(0)
13049# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13050 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13051# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13052 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13053# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13054 global_offset_x = nint(abs(delta_x)/x_step)
13055# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13056 global_offset_y = nint(abs(delta_y)/y_step)
13057# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13058 end select
13059# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13060
13061# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13062 files_loaded = .true.
13063# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13064 end if
13065# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13066
13067# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13068 ! Data assignment
13069# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13070 select case (num_dims)
13071# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13072 case (1)
13073# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13074 idx = i + 1 + global_offset_x
13075# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13076 do f = 1, sys_size
13077# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13078 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13079# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13080 end do
13081# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13082 case (2)
13083# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13084 idx = i + 1 + global_offset_x - index_x
13085# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13086 do f = 1, sys_size - 1
13087# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13088 jump = merge(1, 0, f >= momxe)
13089# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13090 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13091# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13092 end do
13093# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13094 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
13095# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13096 case (3)
13097# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13098 idx = i + 1 + global_offset_x - index_x
13099# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13100 idy = j + 1 + global_offset_y - index_y
13101# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13102 do f = 1, sys_size - 1
13103# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13104 jump = merge(1, 0, f >= momxe)
13105# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13106 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13107# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13108 end do
13109# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13110 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
13111# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13112 end select
13113# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13114 case (380) ! Taylor-Green vortex
13115# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13116 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
13117# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13118 ! geometry 9
13119# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13120 mach = 0.1
13121# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13122 if (patch_id == 1) then
13123# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13124 q_prim_vf(e_idx)%sf(i, j, &
13125# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13126 & 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)
13127# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13128 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
13129# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13130 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
13131# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13132 end if
13133# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13134 case default
13135# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13136 call s_int_to_str(patch_id, istr)
13137# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13138 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
13139# 1078 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13140 end select
13141 end if
13142
13143 ! Updating the patch identities bookkeeping variable
13144 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
13145 end if
13146 end if
13147 end do
13148 end do
13149 end do
13150 if (allocated(stored_values)) then
13151# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13152#ifdef MFC_DEBUG
13153# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13154 block
13155# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13156 use iso_fortran_env, only: output_unit
13157# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13158
13159# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13160 print *, 'm_icpp_patches.fpp:1088: ', '@:DEALLOCATE(stored_values)'
13161# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13162
13163# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13164 call flush (output_unit)
13165# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13166 end block
13167# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13168#endif
13169# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13170
13171# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13172#if defined(MFC_OpenACC)
13173# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13174!$acc exit data delete(stored_values)
13175# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13176#elif defined(MFC_OpenMP)
13177# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13178!$omp target exit data map(release:stored_values)
13179# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13180#endif
13181# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13182 deallocate (stored_values)
13183# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13184#ifdef MFC_DEBUG
13185# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13186 block
13187# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13188 use iso_fortran_env, only: output_unit
13189# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13190
13191# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13192 print *, 'm_icpp_patches.fpp:1088: ', '@:DEALLOCATE(x_coords)'
13193# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13194
13195# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13196 call flush (output_unit)
13197# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13198 end block
13199# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13200#endif
13201# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13202
13203# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13204#if defined(MFC_OpenACC)
13205# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13206!$acc exit data delete(x_coords)
13207# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13208#elif defined(MFC_OpenMP)
13209# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13210!$omp target exit data map(release:x_coords)
13211# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13212#endif
13213# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13214 deallocate (x_coords)
13215# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13216 end if
13217# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13218
13219# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13220 if (allocated(y_coords)) then
13221# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13222#ifdef MFC_DEBUG
13223# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13224 block
13225# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13226 use iso_fortran_env, only: output_unit
13227# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13228
13229# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13230 print *, 'm_icpp_patches.fpp:1088: ', '@:DEALLOCATE(y_coords)'
13231# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13232
13233# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13234 call flush (output_unit)
13235# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13236 end block
13237# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13238#endif
13239# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13240
13241# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242#if defined(MFC_OpenACC)
13243# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244!$acc exit data delete(y_coords)
13245# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246#elif defined(MFC_OpenMP)
13247# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248!$omp target exit data map(release:y_coords)
13249# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250#endif
13251# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 deallocate (y_coords)
13253# 1088 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254 end if
13255
13256 end subroutine s_icpp_cuboid
13257
13258 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
13259 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
13260 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
13261 !! allow for the smoothing of its lateral boundary.
13262 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
13263
13264 integer, intent(in) :: patch_id
13265
13266#ifdef MFC_MIXED_PRECISION
13267 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13268#else
13269 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13270#endif
13271 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13272 integer :: i, j, k !< Generic loop iterators
13273 real(wp) :: radius
13274
13275 integer :: xRows, yRows, nRows, iix, iiy, max_files
13276# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13277 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13278# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13279 real(wp) :: x_len, x_step, y_len, y_step
13280# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13281 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13282# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13283 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
13284# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13285 real(wp) :: delta_x, delta_y
13286# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13287 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
13288# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13289 character(len=200) :: errmsg
13290# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13291 real(wp), allocatable :: stored_values(:,:,:)
13292# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13293 real(wp), allocatable :: x_coords(:), y_coords(:)
13294# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13295 logical :: files_loaded = .false.
13296# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13297 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13298# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13299 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
13300# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13301 character(len=20) :: file_num_str !< For storing the file number as a string
13302# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13303 character(len=20) :: zeros_part !< For the trailing zeros part
13304# 1109 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13305 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
13306 ! Place any declaration of intermediate variables here
13307# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13309# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310 real(wp) :: eps
13311# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312
13313# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314 ! IGR Jets Arrays to stor position and radii of jets from input file
13315# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13317# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318 ! Variables to describe initial condition of jet
13319# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13321# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
13323# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324 real(wp), dimension(0:n,0:p) :: rcut_arr
13325# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326 integer :: l, q, s !< Iterators for reading input files
13327# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328 integer :: start, end !< Ints to keep track of position in file
13329# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330 character(len=1000) :: line !< String to store line in file
13331# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332 character(len=25) :: value !< String to store value in line
13333# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334 integer :: NJet !< Number of jets
13335# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336
13337# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338 eps = 1e-9_wp
13339# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340
13341# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342 if (patch_icpp(patch_id)%hcid == 303) then
13343# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13344 eps_smooth = 3._wp
13345# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13346 open (unit=10, file="njet.txt", status="old", action="read")
13347# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13348 read (10, *) njet
13349# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13350 close (10)
13351# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13352
13353# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13354 allocate (y_th_arr(0:njet - 1))
13355# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13356 allocate (z_th_arr(0:njet - 1))
13357# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13358 allocate (r_th_arr(0:njet - 1))
13359# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13360
13361# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13362 open (unit=10, file="jets.csv", status="old", action="read")
13363# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13364 do q = 0, njet - 1
13365# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13366 read (10, '(A)') line ! Read a full line as a string
13367# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13368 start = 1
13369# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13370
13371# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13372 do l = 0, 2
13373# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13374 end = index(line(start:), ',') ! Find the next comma
13375# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13376 if (end == 0) then
13377# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13378 value = trim(adjustl(line(start:))) ! Last value in the line
13379# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13380 else
13381# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13382 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13383# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13384 start = start + end ! Move to next value
13385# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13386 end if
13387# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13388 if (l == 0) then
13389# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13390 read (value, *) y_th_arr(q) ! Convert string to numeric value
13391# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13392 else if (l == 1) then
13393# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13394 read (value, *) z_th_arr(q)
13395# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13396 else
13397# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13398 read (value, *) r_th_arr(q)
13399# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13400 end if
13401# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13402 end do
13403# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13404 end do
13405# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13406 close (10)
13407# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13408
13409# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13410 do q = 0, p
13411# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13412 do l = 0, n
13413# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13414 rcut = 0._wp
13415# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13416 do s = 0, njet - 1
13417# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13418 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13419# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13420 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13421# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13422 end do
13423# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13424 rcut_arr(l, q) = rcut
13425# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426 end do
13427# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428 end do
13429# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 end if
13431
13432 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
13433 ! information
13434 x_centroid = patch_icpp(patch_id)%x_centroid
13435 y_centroid = patch_icpp(patch_id)%y_centroid
13436 z_centroid = patch_icpp(patch_id)%z_centroid
13437 length_x = patch_icpp(patch_id)%length_x
13438 length_y = patch_icpp(patch_id)%length_y
13439 length_z = patch_icpp(patch_id)%length_z
13440 radius = patch_icpp(patch_id)%radius
13441 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
13442 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
13443
13444 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
13445 x_boundary%beg = x_centroid - 0.5_wp*length_x
13446 x_boundary%end = x_centroid + 0.5_wp*length_x
13447 y_boundary%beg = y_centroid - 0.5_wp*length_y
13448 y_boundary%end = y_centroid + 0.5_wp*length_y
13449 z_boundary%beg = z_centroid - 0.5_wp*length_z
13450 z_boundary%end = z_centroid + 0.5_wp*length_z
13451
13452 ! Initialize eta=1; modified if smoothing is enabled
13453 eta = 1._wp
13454
13455 ! Assign patch vars if cell is covered and patch has write permission
13456 do k = 0, p
13457 do j = 0, n
13458 do i = 0, m
13459 if (grid_geometry == 3) then
13460 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
13461 else
13462 cart_y = y_cc(j)
13463 cart_z = z_cc(k)
13464 end if
13465
13466 if (patch_icpp(patch_id)%smoothen) then
13467 if (.not. f_is_default(length_x)) then
13468 eta = tanh(smooth_coeff/min(dy, &
13469 & dz)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
13470 & + 0.5_wp
13471 else if (.not. f_is_default(length_y)) then
13472 eta = tanh(smooth_coeff/min(dx, &
13473 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
13474 & + 0.5_wp
13475 else
13476 eta = tanh(smooth_coeff/min(dx, &
13477 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
13478 & + 0.5_wp
13479 end if
13480 end if
13481
13482 if (((.not. f_is_default(length_x) .and. (cart_y - y_centroid)**2 + (cart_z - z_centroid) &
13483 & **2 <= radius**2 .and. x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i)) &
13484 & .or. (.not. f_is_default(length_y) .and. (x_cc(i) - x_centroid)**2 + (cart_z - z_centroid) &
13485 & **2 <= radius**2 .and. y_boundary%beg <= cart_y .and. y_boundary%end >= cart_y) &
13486 & .or. (.not. f_is_default(length_z) .and. (x_cc(i) - x_centroid)**2 + (cart_y - y_centroid) &
13487 & **2 <= radius**2 .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) &
13488 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
13489 & k) == smooth_patch_id) then
13490 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
13491
13492
13493 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13494 select case (patch_icpp(patch_id)%hcid)
13495# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13496 case (300) ! Rayleigh-Taylor instability
13497# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13498 rhoh = 3._wp
13499# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13500 rhol = 1._wp
13501# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13502 pref = 1.e5_wp
13503# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13504 pint = pref
13505# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13506 h = 0.7_wp
13507# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13508 lam = 0.2_wp
13509# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13510 wl = 2._wp*pi/lam
13511# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13512 amp = 0.025_wp/wl
13513# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13514
13515# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13516 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
13517# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13518
13519# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13520 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13521# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13522
13523# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13524 if (alph < eps) alph = eps
13525# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13526 if (alph > 1._wp - eps) alph = 1._wp - eps
13527# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13528
13529# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13530 if (y_cc(j) > inth) then
13531# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13532 q_prim_vf(advxb)%sf(i, j, k) = alph
13533# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13534 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13535# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13536 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13537# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13538 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13539# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13540 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13541# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13542 else
13543# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13544 q_prim_vf(advxb)%sf(i, j, k) = alph
13545# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13546 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13547# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13548 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13549# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13550 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13551# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13552 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13553# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13554 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13555# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13556 end if
13557# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13558 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13559# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13560 h = 0.0_wp
13561# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13562 lam = 1.0_wp
13563# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13564 amp = patch_icpp(patch_id)%a(2)
13565# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13566 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13567# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13568 if (x_cc(i) > inth) then
13569# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13570 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13571# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13572 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13573# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13574 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
13575# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13576 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13577# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13578 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13579# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13580 end if
13581# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13582 case (302) ! 3D Jet with IGR
13583# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13584 ux_th = 10*sqrt(1.4*0.4)
13585# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13586 ux_am = 0.0*sqrt(1.4)
13587# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13588 p_th = 2.0_wp
13589# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13590 p_am = 1.0_wp
13591# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13592 rho_th = 1._wp
13593# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13594 rho_am = 1._wp
13595# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13596 y_th = 0.0_wp
13597# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13598 z_th = 0.0_wp
13599# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13600 r_th = 1._wp
13601# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13602 eps_smooth = 1._wp
13603# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13604 eps = 1e-6
13605# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13606
13607# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13608 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13609# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13610 rcut = f_cut_on(r - r_th, eps_smooth)
13611# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612 xcut = f_cut_on(x_cc(i), eps_smooth)
13613# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614
13615# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13617# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13619# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13621# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622
13623# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 if (num_fluids == 1) then
13625# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13627# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628 else
13629# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13631# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13633# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13635# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636 end if
13637# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638
13639# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13641# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642 case (303) ! 3D Multijet
13643# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644 eps_smooth = 3.0_wp
13645# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 ux_th = 10*sqrt(1.4*0.4)
13647# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 ux_am = 2.5*sqrt(1.4*0.4)
13649# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 p_th = 0.8_wp
13651# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 p_am = 0.4_wp
13653# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654 rho_th = 1._wp
13655# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656 rho_am = 1._wp
13657# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 eps = 1e-6
13659# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660
13661# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662 rcut = rcut_arr(j, k)
13663# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 xcut = f_cut_on(x_cc(i), eps_smooth)
13665# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666
13667# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13669# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13671# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13673# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674
13675# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676 if (num_fluids == 1) then
13677# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13679# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 else
13681# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13683# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13685# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13687# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688 end if
13689# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690
13691# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13693# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694 case (370) ! 3D extrusion of 2D profile from external data
13695# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13697# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698 if (.not. files_loaded) then
13699# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13701# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702 do f = 1, max_files
13703# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704 write (file_num_str, '(I0)') f
13705# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
13707# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 end do
13709# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710
13711# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712 ! Common file reading setup
13713# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13715# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13717# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718
13719# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720 select case (num_dims)
13721# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722 case (1, 2) ! 1D and 2D cases are similar
13723# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724 ! Count lines
13725# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726 line_count = 0
13727# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728 do
13729# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13731# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 if (ios2 /= 0) exit
13733# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 line_count = line_count + 1
13735# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736 end do
13737# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738 close (unit2)
13739# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740
13741# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 xrows = line_count
13743# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 yrows = 1
13745# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 index_x = 0
13747# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 if (num_dims == 2) index_x = i
13749# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750#ifdef MFC_DEBUG
13751# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752 block
13753# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754 use iso_fortran_env, only: output_unit
13755# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756
13757# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 print *, 'm_icpp_patches.fpp:1174: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13759# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760
13761# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 call flush (output_unit)
13763# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 end block
13765# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766#endif
13767# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13769# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770
13771# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772
13773# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774
13775# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776#if defined(MFC_OpenACC)
13777# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778!$acc enter data create(x_coords, stored_values)
13779# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780#elif defined(MFC_OpenMP)
13781# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782!$omp target enter data map(always,alloc:x_coords, stored_values)
13783# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784#endif
13785# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786
13787# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788 ! Read data from all files
13789# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790 do f = 1, max_files
13791# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13793# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13795# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796
13797# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798 do iter = 1, xrows
13799# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13801# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13803# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804 end do
13805# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806 close (unit)
13807# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808 end do
13809# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810
13811# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 ! Calculate offsets
13813# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814 domain_xstart = x_coords(1)
13815# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 x_step = x_cc(1) - x_cc(0)
13817# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818 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)
13819# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820 global_offset_x = nint(abs(delta_x)/x_step)
13821# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822 case (3) ! 3D case - determine grid structure
13823# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824 ! Find yRows by counting rows with same x
13825# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13826 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13827# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13828 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13829# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13830
13831# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13832 yrows = 1
13833# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834 do
13835# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13837# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 if (ios2 /= 0) exit
13839# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840 if (dummy_x == x0 .and. dummy_y /= y0) then
13841# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842 yrows = yrows + 1
13843# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844 else
13845# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846 exit
13847# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848 end if
13849# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850 end do
13851# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852 close (unit2)
13853# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854
13855# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856 ! Count total rows
13857# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13859# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860 nrows = 0
13861# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862 do
13863# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13865# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866 if (ios2 /= 0) exit
13867# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868 nrows = nrows + 1
13869# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870 end do
13871# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872 close (unit2)
13873# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874
13875# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876 xrows = nrows/yrows
13877# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878#ifdef MFC_DEBUG
13879# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880 block
13881# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882 use iso_fortran_env, only: output_unit
13883# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884
13885# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886 print *, 'm_icpp_patches.fpp:1174: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13887# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888
13889# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890 call flush (output_unit)
13891# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892 end block
13893# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894#endif
13895# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13897# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898
13899# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900
13901# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902
13903# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904
13905# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906#if defined(MFC_OpenACC)
13907# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908!$acc enter data create(x_coords, y_coords, stored_values)
13909# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910#elif defined(MFC_OpenMP)
13911# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13913# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914#endif
13915# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 index_x = i
13917# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 index_y = j
13919# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920
13921# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922 ! Read all files
13923# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924 do f = 1, max_files
13925# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13927# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928 if (ios /= 0) then
13929# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13931# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932 cycle
13933# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 end if
13935# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936
13937# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938 iter = 0
13939# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 do iix = 1, xrows
13941# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942 do iiy = 1, yrows
13943# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944 iter = iter + 1
13945# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946 if (f == 1) then
13947# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13949# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 else
13951# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13953# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954 end if
13955# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956 if (ios /= 0) call s_mpi_abort("Error reading data")
13957# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 end do
13959# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 end do
13961# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962 close (unit)
13963# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964 end do
13965# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966
13967# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968 ! Calculate offsets
13969# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970 x_step = x_cc(1) - x_cc(0)
13971# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972 y_step = y_cc(1) - y_cc(0)
13973# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13975# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13977# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 global_offset_x = nint(abs(delta_x)/x_step)
13979# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980 global_offset_y = nint(abs(delta_y)/y_step)
13981# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 end select
13983# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13984
13985# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13986 files_loaded = .true.
13987# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13988 end if
13989# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13990
13991# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13992 ! Data assignment
13993# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13994 select case (num_dims)
13995# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13996 case (1)
13997# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13998 idx = i + 1 + global_offset_x
13999# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14000 do f = 1, sys_size
14001# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14002 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14003# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14004 end do
14005# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14006 case (2)
14007# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14008 idx = i + 1 + global_offset_x - index_x
14009# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14010 do f = 1, sys_size - 1
14011# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14012 jump = merge(1, 0, f >= momxe)
14013# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14014 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14015# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14016 end do
14017# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14018 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
14019# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14020 case (3)
14021# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14022 idx = i + 1 + global_offset_x - index_x
14023# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14024 idy = j + 1 + global_offset_y - index_y
14025# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14026 do f = 1, sys_size - 1
14027# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14028 jump = merge(1, 0, f >= momxe)
14029# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14030 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14031# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14032 end do
14033# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14034 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
14035# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14036 end select
14037# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14038 case (380) ! Taylor-Green vortex
14039# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14040 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
14041# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14042 ! geometry 9
14043# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14044 mach = 0.1
14045# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14046 if (patch_id == 1) then
14047# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14048 q_prim_vf(e_idx)%sf(i, j, &
14049# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14050 & 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)
14051# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14052 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14053# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14054 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14055# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14056 end if
14057# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14058 case default
14059# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14060 call s_int_to_str(patch_id, istr)
14061# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14062 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14063# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14064 end select
14065 end if
14066
14067 ! Updating the patch identities bookkeeping variable
14068 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14069 end if
14070 end do
14071 end do
14072 end do
14073 if (allocated(stored_values)) then
14074# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075#ifdef MFC_DEBUG
14076# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077 block
14078# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 use iso_fortran_env, only: output_unit
14080# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081
14082# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(stored_values)'
14084# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085
14086# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087 call flush (output_unit)
14088# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089 end block
14090# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091#endif
14092# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093
14094# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095#if defined(MFC_OpenACC)
14096# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097!$acc exit data delete(stored_values)
14098# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099#elif defined(MFC_OpenMP)
14100# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101!$omp target exit data map(release:stored_values)
14102# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103#endif
14104# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105 deallocate (stored_values)
14106# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107#ifdef MFC_DEBUG
14108# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 block
14110# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14111 use iso_fortran_env, only: output_unit
14112# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14113
14114# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14115 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(x_coords)'
14116# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14117
14118# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14119 call flush (output_unit)
14120# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14121 end block
14122# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14123#endif
14124# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14125
14126# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14127#if defined(MFC_OpenACC)
14128# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14129!$acc exit data delete(x_coords)
14130# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14131#elif defined(MFC_OpenMP)
14132# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14133!$omp target exit data map(release:x_coords)
14134# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14135#endif
14136# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14137 deallocate (x_coords)
14138# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14139 end if
14140# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14141
14142# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14143 if (allocated(y_coords)) then
14144# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14145#ifdef MFC_DEBUG
14146# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14147 block
14148# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14149 use iso_fortran_env, only: output_unit
14150# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14151
14152# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14153 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(y_coords)'
14154# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14155
14156# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14157 call flush (output_unit)
14158# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14159 end block
14160# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14161#endif
14162# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14163
14164# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14165#if defined(MFC_OpenACC)
14166# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14167!$acc exit data delete(y_coords)
14168# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14169#elif defined(MFC_OpenMP)
14170# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14171!$omp target exit data map(release:y_coords)
14172# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14173#endif
14174# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14175 deallocate (y_coords)
14176# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14177 end if
14178
14179 end subroutine s_icpp_cylinder
14180
14181 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
14182 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
14183 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
14184 !! the smoothing of its boundary.
14185 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
14186
14187 integer, intent(in) :: patch_id
14188
14189#ifdef MFC_MIXED_PRECISION
14190 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14191#else
14192 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14193#endif
14194 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14195 integer :: i, j, k !< Generic loop iterators
14196 real(wp) :: a, b, c, d
14197
14198 integer :: xRows, yRows, nRows, iix, iiy, max_files
14199# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14200 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14201# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14202 real(wp) :: x_len, x_step, y_len, y_step
14203# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14204 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14205# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14206 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
14207# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14208 real(wp) :: delta_x, delta_y
14209# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14210 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
14211# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14212 character(len=200) :: errmsg
14213# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14214 real(wp), allocatable :: stored_values(:,:,:)
14215# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14216 real(wp), allocatable :: x_coords(:), y_coords(:)
14217# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14218 logical :: files_loaded = .false.
14219# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14220 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14221# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14222 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
14223# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14224 character(len=20) :: file_num_str !< For storing the file number as a string
14225# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14226 character(len=20) :: zeros_part !< For the trailing zeros part
14227# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14228 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
14229 ! Place any declaration of intermediate variables here
14230# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14232# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233 real(wp) :: eps
14234# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235
14236# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237 ! IGR Jets Arrays to stor position and radii of jets from input file
14238# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14240# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241 ! Variables to describe initial condition of jet
14242# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14244# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
14246# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 real(wp), dimension(0:n,0:p) :: rcut_arr
14248# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249 integer :: l, q, s !< Iterators for reading input files
14250# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251 integer :: start, end !< Ints to keep track of position in file
14252# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253 character(len=1000) :: line !< String to store line in file
14254# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255 character(len=25) :: value !< String to store value in line
14256# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257 integer :: NJet !< Number of jets
14258# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259
14260# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261 eps = 1e-9_wp
14262# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263
14264# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265 if (patch_icpp(patch_id)%hcid == 303) then
14266# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267 eps_smooth = 3._wp
14268# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269 open (unit=10, file="njet.txt", status="old", action="read")
14270# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271 read (10, *) njet
14272# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273 close (10)
14274# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275
14276# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277 allocate (y_th_arr(0:njet - 1))
14278# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279 allocate (z_th_arr(0:njet - 1))
14280# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281 allocate (r_th_arr(0:njet - 1))
14282# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283
14284# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 open (unit=10, file="jets.csv", status="old", action="read")
14286# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 do q = 0, njet - 1
14288# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14289 read (10, '(A)') line ! Read a full line as a string
14290# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14291 start = 1
14292# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14293
14294# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14295 do l = 0, 2
14296# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14297 end = index(line(start:), ',') ! Find the next comma
14298# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14299 if (end == 0) then
14300# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14301 value = trim(adjustl(line(start:))) ! Last value in the line
14302# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14303 else
14304# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14305 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14306# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14307 start = start + end ! Move to next value
14308# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14309 end if
14310# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14311 if (l == 0) then
14312# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14313 read (value, *) y_th_arr(q) ! Convert string to numeric value
14314# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14315 else if (l == 1) then
14316# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317 read (value, *) z_th_arr(q)
14318# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 else
14320# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 read (value, *) r_th_arr(q)
14322# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323 end if
14324# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325 end do
14326# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14327 end do
14328# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14329 close (10)
14330# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14331
14332# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14333 do q = 0, p
14334# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14335 do l = 0, n
14336# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14337 rcut = 0._wp
14338# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14339 do s = 0, njet - 1
14340# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14342# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14344# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14345 end do
14346# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14347 rcut_arr(l, q) = rcut
14348# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14349 end do
14350# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14351 end do
14352# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14353 end if
14354
14355 ! Transferring the centroid information of the plane to be swept
14356 x_centroid = patch_icpp(patch_id)%x_centroid
14357 y_centroid = patch_icpp(patch_id)%y_centroid
14358 z_centroid = patch_icpp(patch_id)%z_centroid
14359 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14360 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14361
14362 ! Obtaining coefficients of the equation describing the sweep plane
14363 a = patch_icpp(patch_id)%normal(1)
14364 b = patch_icpp(patch_id)%normal(2)
14365 c = patch_icpp(patch_id)%normal(3)
14366 d = -a*x_centroid - b*y_centroid - c*z_centroid
14367
14368 ! Initialize eta=1; modified if smoothing is enabled
14369 eta = 1._wp
14370
14371 ! Assign patch vars if cell is covered and patch has write permission
14372 do k = 0, p
14373 do j = 0, n
14374 do i = 0, m
14375 if (grid_geometry == 3) then
14376 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
14377 else
14378 cart_y = y_cc(j)
14379 cart_z = z_cc(k)
14380 end if
14381
14382 if (patch_icpp(patch_id)%smoothen) then
14383 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, &
14384 & dz)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
14385 end if
14386
14387 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, &
14388 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
14389 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
14390
14391
14392 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14393 select case (patch_icpp(patch_id)%hcid)
14394# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14395 case (300) ! Rayleigh-Taylor instability
14396# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14397 rhoh = 3._wp
14398# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14399 rhol = 1._wp
14400# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14401 pref = 1.e5_wp
14402# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14403 pint = pref
14404# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14405 h = 0.7_wp
14406# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14407 lam = 0.2_wp
14408# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14409 wl = 2._wp*pi/lam
14410# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14411 amp = 0.025_wp/wl
14412# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14413
14414# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14415 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
14416# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14417
14418# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14419 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14420# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14421
14422# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14423 if (alph < eps) alph = eps
14424# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14425 if (alph > 1._wp - eps) alph = 1._wp - eps
14426# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14427
14428# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14429 if (y_cc(j) > inth) then
14430# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14431 q_prim_vf(advxb)%sf(i, j, k) = alph
14432# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14433 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14434# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14435 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14436# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14437 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14438# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14439 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14440# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14441 else
14442# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14443 q_prim_vf(advxb)%sf(i, j, k) = alph
14444# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14445 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14446# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14447 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14448# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14449 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14450# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14451 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14452# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14453 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14454# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14455 end if
14456# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14457 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14458# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14459 h = 0.0_wp
14460# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14461 lam = 1.0_wp
14462# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14463 amp = patch_icpp(patch_id)%a(2)
14464# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14465 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14466# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14467 if (x_cc(i) > inth) then
14468# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14469 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14470# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14471 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14472# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14473 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
14474# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14475 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14476# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14477 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14478# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14479 end if
14480# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14481 case (302) ! 3D Jet with IGR
14482# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14483 ux_th = 10*sqrt(1.4*0.4)
14484# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14485 ux_am = 0.0*sqrt(1.4)
14486# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14487 p_th = 2.0_wp
14488# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14489 p_am = 1.0_wp
14490# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14491 rho_th = 1._wp
14492# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14493 rho_am = 1._wp
14494# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14495 y_th = 0.0_wp
14496# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14497 z_th = 0.0_wp
14498# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14499 r_th = 1._wp
14500# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14501 eps_smooth = 1._wp
14502# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14503 eps = 1e-6
14504# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14505
14506# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14507 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14508# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14509 rcut = f_cut_on(r - r_th, eps_smooth)
14510# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14511 xcut = f_cut_on(x_cc(i), eps_smooth)
14512# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14513
14514# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14515 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14516# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14517 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14518# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14519 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14520# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14521
14522# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14523 if (num_fluids == 1) then
14524# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14525 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14526# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14527 else
14528# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14529 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14530# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14531 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14532# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14533 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14534# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14535 end if
14536# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14537
14538# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14539 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14540# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14541 case (303) ! 3D Multijet
14542# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14543 eps_smooth = 3.0_wp
14544# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14545 ux_th = 10*sqrt(1.4*0.4)
14546# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14547 ux_am = 2.5*sqrt(1.4*0.4)
14548# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14549 p_th = 0.8_wp
14550# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14551 p_am = 0.4_wp
14552# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14553 rho_th = 1._wp
14554# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14555 rho_am = 1._wp
14556# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14557 eps = 1e-6
14558# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14559
14560# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14561 rcut = rcut_arr(j, k)
14562# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14563 xcut = f_cut_on(x_cc(i), eps_smooth)
14564# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14565
14566# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14567 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14568# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14569 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14570# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14571 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14572# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14573
14574# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14575 if (num_fluids == 1) then
14576# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14577 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14578# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14579 else
14580# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14581 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14582# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14583 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14584# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14585 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14586# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14587 end if
14588# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14589
14590# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14591 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14592# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14593 case (370) ! 3D extrusion of 2D profile from external data
14594# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14595 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14596# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14597 if (.not. files_loaded) then
14598# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14599 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14600# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14601 do f = 1, max_files
14602# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14603 write (file_num_str, '(I0)') f
14604# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14605 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
14606# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14607 end do
14608# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14609
14610# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14611 ! Common file reading setup
14612# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14613 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14614# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14615 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14616# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14617
14618# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14619 select case (num_dims)
14620# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14621 case (1, 2) ! 1D and 2D cases are similar
14622# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14623 ! Count lines
14624# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14625 line_count = 0
14626# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14627 do
14628# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14629 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14630# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14631 if (ios2 /= 0) exit
14632# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14633 line_count = line_count + 1
14634# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14635 end do
14636# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14637 close (unit2)
14638# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14639
14640# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14641 xrows = line_count
14642# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14643 yrows = 1
14644# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14645 index_x = 0
14646# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14647 if (num_dims == 2) index_x = i
14648# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14649#ifdef MFC_DEBUG
14650# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14651 block
14652# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14653 use iso_fortran_env, only: output_unit
14654# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14655
14656# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14657 print *, 'm_icpp_patches.fpp:1245: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14658# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14659
14660# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14661 call flush (output_unit)
14662# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14663 end block
14664# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14665#endif
14666# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14667 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14668# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14669
14670# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14671
14672# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14673
14674# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14675#if defined(MFC_OpenACC)
14676# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14677!$acc enter data create(x_coords, stored_values)
14678# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14679#elif defined(MFC_OpenMP)
14680# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14681!$omp target enter data map(always,alloc:x_coords, stored_values)
14682# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14683#endif
14684# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14685
14686# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14687 ! Read data from all files
14688# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14689 do f = 1, max_files
14690# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14691 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14692# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14693 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14694# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14695
14696# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14697 do iter = 1, xrows
14698# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14699 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14700# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14701 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14702# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14703 end do
14704# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14705 close (unit)
14706# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14707 end do
14708# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14709
14710# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14711 ! Calculate offsets
14712# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14713 domain_xstart = x_coords(1)
14714# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14715 x_step = x_cc(1) - x_cc(0)
14716# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14717 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)
14718# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14719 global_offset_x = nint(abs(delta_x)/x_step)
14720# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14721 case (3) ! 3D case - determine grid structure
14722# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14723 ! Find yRows by counting rows with same x
14724# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14725 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14726# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14727 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14728# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14729
14730# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14731 yrows = 1
14732# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14733 do
14734# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14735 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14736# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14737 if (ios2 /= 0) exit
14738# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14739 if (dummy_x == x0 .and. dummy_y /= y0) then
14740# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14741 yrows = yrows + 1
14742# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14743 else
14744# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14745 exit
14746# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14747 end if
14748# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14749 end do
14750# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14751 close (unit2)
14752# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14753
14754# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14755 ! Count total rows
14756# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14757 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14758# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14759 nrows = 0
14760# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14761 do
14762# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14763 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14764# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14765 if (ios2 /= 0) exit
14766# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14767 nrows = nrows + 1
14768# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14769 end do
14770# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14771 close (unit2)
14772# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14773
14774# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14775 xrows = nrows/yrows
14776# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14777#ifdef MFC_DEBUG
14778# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14779 block
14780# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14781 use iso_fortran_env, only: output_unit
14782# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14783
14784# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14785 print *, 'm_icpp_patches.fpp:1245: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14786# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14787
14788# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14789 call flush (output_unit)
14790# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14791 end block
14792# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14793#endif
14794# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14795 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14796# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14797
14798# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14799
14800# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14801
14802# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14803
14804# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14805#if defined(MFC_OpenACC)
14806# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14807!$acc enter data create(x_coords, y_coords, stored_values)
14808# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14809#elif defined(MFC_OpenMP)
14810# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14811!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14812# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14813#endif
14814# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14815 index_x = i
14816# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14817 index_y = j
14818# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14819
14820# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14821 ! Read all files
14822# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14823 do f = 1, max_files
14824# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14825 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14826# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14827 if (ios /= 0) then
14828# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14829 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14830# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14831 cycle
14832# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14833 end if
14834# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14835
14836# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14837 iter = 0
14838# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14839 do iix = 1, xrows
14840# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14841 do iiy = 1, yrows
14842# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14843 iter = iter + 1
14844# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14845 if (f == 1) then
14846# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14847 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14848# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14849 else
14850# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14851 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14852# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14853 end if
14854# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14855 if (ios /= 0) call s_mpi_abort("Error reading data")
14856# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14857 end do
14858# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14859 end do
14860# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14861 close (unit)
14862# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14863 end do
14864# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14865
14866# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14867 ! Calculate offsets
14868# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14869 x_step = x_cc(1) - x_cc(0)
14870# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14871 y_step = y_cc(1) - y_cc(0)
14872# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14873 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14874# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14875 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14876# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14877 global_offset_x = nint(abs(delta_x)/x_step)
14878# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14879 global_offset_y = nint(abs(delta_y)/y_step)
14880# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14881 end select
14882# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14883
14884# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14885 files_loaded = .true.
14886# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14887 end if
14888# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14889
14890# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14891 ! Data assignment
14892# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14893 select case (num_dims)
14894# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14895 case (1)
14896# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14897 idx = i + 1 + global_offset_x
14898# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14899 do f = 1, sys_size
14900# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14901 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14902# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14903 end do
14904# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14905 case (2)
14906# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14907 idx = i + 1 + global_offset_x - index_x
14908# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14909 do f = 1, sys_size - 1
14910# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14911 jump = merge(1, 0, f >= momxe)
14912# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14913 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14914# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14915 end do
14916# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14917 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
14918# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14919 case (3)
14920# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14921 idx = i + 1 + global_offset_x - index_x
14922# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14923 idy = j + 1 + global_offset_y - index_y
14924# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14925 do f = 1, sys_size - 1
14926# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14927 jump = merge(1, 0, f >= momxe)
14928# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14929 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14930# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14931 end do
14932# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14933 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
14934# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14935 end select
14936# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14937 case (380) ! Taylor-Green vortex
14938# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14939 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
14940# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14941 ! geometry 9
14942# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14943 mach = 0.1
14944# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14945 if (patch_id == 1) then
14946# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14947 q_prim_vf(e_idx)%sf(i, j, &
14948# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14949 & 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)
14950# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14951 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14952# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14953 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14954# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14955 end if
14956# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14957 case default
14958# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14959 call s_int_to_str(patch_id, istr)
14960# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14961 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14962# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14963 end select
14964 end if
14965
14966 ! Updating the patch identities bookkeeping variable
14967 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14968 end if
14969 end do
14970 end do
14971 end do
14972 if (allocated(stored_values)) then
14973# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974#ifdef MFC_DEBUG
14975# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 block
14977# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978 use iso_fortran_env, only: output_unit
14979# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980
14981# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(stored_values)'
14983# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984
14985# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986 call flush (output_unit)
14987# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988 end block
14989# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990#endif
14991# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992
14993# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994#if defined(MFC_OpenACC)
14995# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996!$acc exit data delete(stored_values)
14997# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998#elif defined(MFC_OpenMP)
14999# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000!$omp target exit data map(release:stored_values)
15001# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002#endif
15003# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004 deallocate (stored_values)
15005# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006#ifdef MFC_DEBUG
15007# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008 block
15009# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010 use iso_fortran_env, only: output_unit
15011# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15012
15013# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15014 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(x_coords)'
15015# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15016
15017# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15018 call flush (output_unit)
15019# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15020 end block
15021# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15022#endif
15023# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15024
15025# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15026#if defined(MFC_OpenACC)
15027# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15028!$acc exit data delete(x_coords)
15029# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15030#elif defined(MFC_OpenMP)
15031# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15032!$omp target exit data map(release:x_coords)
15033# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15034#endif
15035# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15036 deallocate (x_coords)
15037# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15038 end if
15039# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15040
15041# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15042 if (allocated(y_coords)) then
15043# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15044#ifdef MFC_DEBUG
15045# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15046 block
15047# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15048 use iso_fortran_env, only: output_unit
15049# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15050
15051# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15052 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(y_coords)'
15053# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15054
15055# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15056 call flush (output_unit)
15057# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15058 end block
15059# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15060#endif
15061# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15062
15063# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15064#if defined(MFC_OpenACC)
15065# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15066!$acc exit data delete(y_coords)
15067# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15068#elif defined(MFC_OpenMP)
15069# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15070!$omp target exit data map(release:y_coords)
15071# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15072#endif
15073# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15074 deallocate (y_coords)
15075# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15076 end if
15077
15078 end subroutine s_icpp_sweep_plane
15079
15080 !> The STL patch is a 2/3D geometry that is imported from an STL file.
15081 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
15082
15083 integer, intent(in) :: patch_id
15084
15085#ifdef MFC_MIXED_PRECISION
15086 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15087#else
15088 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15089#endif
15090 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15091
15092 ! Variables for IBM+STL
15093 real(wp) :: normals(1:3) !< Boundary normal buffer
15094 integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex
15095 real(wp), allocatable, dimension(:,:,:) :: boundary_v !< Boundary vertex buffer
15096 real(wp) :: distance !< Levelset distance buffer
15097 logical :: interpolate !< Logical variable to determine whether or not the model should be interpolated
15098 integer :: i, j, k !< Generic loop iterators
15099 type(t_bbox) :: bbox, bbox_old
15100 type(t_model) :: model
15101 type(ic_model_parameters) :: params
15102 real(wp), dimension(1:3) :: point, model_center
15103 real(wp) :: grid_mm(1:3,1:2)
15104 integer :: cell_num
15105 integer :: ncells
15106 real(wp), dimension(1:4,1:4) :: transform, transform_n
15107
15108 if (proc_rank == 0) then
15109 print *, " * Reading model: " // trim(patch_icpp(patch_id)%model_filepath)
15110 end if
15111
15112 model = f_model_read(patch_icpp(patch_id)%model_filepath)
15113 params%scale(:) = patch_icpp(patch_id)%model_scale(:)
15114 params%translate(:) = patch_icpp(patch_id)%model_translate(:)
15115 params%rotate(:) = patch_icpp(patch_id)%model_rotate(:)
15116 params%spc = patch_icpp(patch_id)%model_spc
15117 params%threshold = patch_icpp(patch_id)%model_threshold
15118
15119 if (proc_rank == 0) then
15120 print *, " * Transforming model."
15121 end if
15122
15123 ! Get the model center before transforming the model
15124 bbox_old = f_create_bbox(model)
15125 model_center(1:3) = (bbox_old%min(1:3) + bbox_old%max(1:3))/2._wp
15126
15127 ! Compute the transform matrices for vertices and normals
15128 transform = f_create_transform_matrix(params, model_center)
15129 transform_n = f_create_transform_matrix(params)
15130
15131 call s_transform_model(model, transform, transform_n)
15132
15133 ! Recreate the bounding box after transformation
15134 bbox = f_create_bbox(model)
15135
15136 ! Show the number of vertices in the original STL model
15137 if (proc_rank == 0) then
15138 print *, ' * Number of input model vertices:', 3*model%ntrs
15139 end if
15140
15141 call s_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count)
15142
15143 ! Show the number of edges and boundary edges in 2D STL models
15144 if (proc_rank == 0 .and. p == 0) then
15145 print *, ' * Number of 2D model boundary edges:', boundary_edge_count
15146 end if
15147
15148 if (proc_rank == 0) then
15149 write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3)
15150 write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp
15151 write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3)
15152
15153 grid_mm(1,:) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/)
15154 grid_mm(2,:) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/)
15155
15156 if (p > 0) then
15157 grid_mm(3,:) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/)
15158 else
15159 grid_mm(3,:) = (/0._wp, 0._wp/)
15160 end if
15161
15162 write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:,1)
15163 write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:,1) + grid_mm(:,2))/2._wp
15164 write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:,2)
15165 end if
15166
15167 ncells = (m + 1)*(n + 1)*(p + 1)
15168 do i = 0, m; do j = 0, n; do k = 0, p
15169 cell_num = i*(n + 1)*(p + 1) + j*(p + 1) + (k + 1)
15170 if (proc_rank == 0 .and. mod(cell_num, ncells/100) == 0) then
15171 write (*, "(A, I3, A)", advance="no") char(13) // " * Generating grid: ", nint(100*real(cell_num)/ncells), "%"
15172 end if
15173
15174 point = (/x_cc(i), y_cc(j), 0._wp/)
15175 if (p > 0) then
15176 point(3) = z_cc(k)
15177 end if
15178
15179 if (grid_geometry == 3) then
15180 point = f_convert_cyl_to_cart(point)
15181 end if
15182
15183 eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc)
15184
15185 if (eta > patch_icpp(patch_id)%model_threshold) then
15186 eta = 1._wp
15187 else if (.not. patch_icpp(patch_id)%smoothen) then
15188 eta = 0._wp
15189 end if
15190
15191 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
15192
15193 ! Note: Should probably use *eta* to compute primitive variables if defining them analytically.
15194
15195 end do; end do; end do
15196
15197 if (proc_rank == 0) then
15198 print *, ""
15199 print *, " * Cleaning up."
15200 end if
15201
15202 call s_model_free(model)
15203
15204 end subroutine s_icpp_model
15205
15206 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
15207 subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
15208
15209
15210# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15211#if MFC_OpenACC
15212# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15213!$acc routine seq
15214# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15215#elif MFC_OpenMP
15216# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15217
15218# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15219
15220# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15221!$omp declare target device_type(any)
15222# 1387 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15223#endif
15224
15225 real(wp), intent(in) :: cyl_y, cyl_z
15226
15227 cart_y = cyl_y*sin(cyl_z)
15228 cart_z = cyl_y*cos(cyl_z)
15229
15230 end subroutine s_convert_cylindrical_to_cartesian_coord
15231
15232 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
15233 function f_convert_cyl_to_cart(cyl) result(cart)
15234
15235
15236# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15237#if MFC_OpenACC
15238# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15239!$acc routine seq
15240# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15241#elif MFC_OpenMP
15242# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15243
15244# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15245
15246# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15247!$omp declare target device_type(any)
15248# 1399 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15249#endif
15250
15251 real(wp), dimension(1:3), intent(in) :: cyl
15252 real(wp), dimension(1:3) :: cart
15253
15254 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
15255
15256 end function f_convert_cyl_to_cart
15257
15258 !> Compute the spherical azimuthal angle from cylindrical (x, r) coordinates.
15259 subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y)
15260
15261
15262# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15263#if MFC_OpenACC
15264# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15265!$acc routine seq
15266# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15267#elif MFC_OpenMP
15268# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15269
15270# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15271
15272# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15273!$omp declare target device_type(any)
15274# 1411 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15275#endif
15276
15277 real(wp), intent(in) :: cyl_x, cyl_y
15278
15279 sph_phi = atan(cyl_y/cyl_x)
15280
15281 end subroutine s_convert_cylindrical_to_spherical_coord
15282
15283 !> Archimedes spiral function
15284 elemental function f_r(myth, offset, a)
15285
15286
15287# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15288#if MFC_OpenACC
15289# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15290!$acc routine seq
15291# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15292#elif MFC_OpenMP
15293# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15294
15295# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15296
15297# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15298!$omp declare target device_type(any)
15299# 1422 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15300#endif
15301 real(wp), intent(in) :: myth, offset, a
15302 real(wp) :: b
15303 real(wp) :: f_r
15304
15305 ! r(th) = a + b*th
15306
15307 b = 2._wp*a/(2._wp*pi)
15308 f_r = a + b*myth + offset
15309
15310 end function f_r
15311
15312end module m_icpp_patches
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1064
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1064
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1064
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:343
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
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:29
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:30
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:42
m_global_parameters::sys_size
integer sys_size
Number of unknowns in the system of equations.
Definition m_global_parameters.fpp.f90:76
m_global_parameters::num_patches
integer num_patches
Number of patches composing initial condition.
Definition m_global_parameters.fpp.f90:156
m_global_parameters::b_idx
type(int_bounds_info) b_idx
Indexes of first and last magnetic field eqns.
Definition m_global_parameters.fpp.f90:106
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:51
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:56
m_global_parameters::patch_icpp
type(ic_patch_parameters), dimension(num_patches_max) patch_icpp
IC patch parameters (max: num_patches_max).
Definition m_global_parameters.fpp.f90:157
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:45
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:44
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:43
m_global_parameters::momxb
integer momxb
Definition m_global_parameters.fpp.f90:211
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
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:5486
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:15234
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:2316
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:9566
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:12365
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:3453
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:11349
m_icpp_patches::cart_z
real(wp) cart_z
Definition m_icpp_patches.fpp.f90:409
m_icpp_patches::s_convert_cylindrical_to_spherical_coord
subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y)
Compute the spherical azimuthal angle from cylindrical (x, r) coordinates.
Definition m_icpp_patches.fpp.f90:15260
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:412
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:14186
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:7527
m_icpp_patches::sph_phi
real(wp) sph_phi
Spherical phi for Cartesian conversion in cylindrical coordinates.
Definition m_icpp_patches.fpp.f90:410
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:418
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:533
m_icpp_patches::y_boundary
type(bounds_info) y_boundary
Definition m_icpp_patches.fpp.f90:411
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:11468
m_icpp_patches::eta
real(wp) eta
Pseudo volume fraction for patch boundary smoothing.
Definition m_icpp_patches.fpp.f90:408
m_icpp_patches::cart_x
real(wp) cart_x
Definition m_icpp_patches.fpp.f90:409
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:10718
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:11404
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:15082
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:15208
m_icpp_patches::f_r
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
Definition m_icpp_patches.fpp.f90:15285
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:411
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:411
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:8681
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:6626
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:13263
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:1167
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:4594
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:318
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:852
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:361
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:361
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:361
m_derived_types::bounds_info
Derived type adding beginning (beg) and end bounds info as attributes.
Definition m_derived_types.fpp.f90:431
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331