MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_icpp_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_icpp_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp" 1
18!> Allocate memory and read initial condition data for IC extrusion.
19!>
20!> @details
21!> This macro handles the complete initialization process for IC extrusion by:
22!>
23!> **Memory Allocation:**
24!> - stored_values(xRows, yRows, sys_size) - stores primitive variable data from files
25!> - x_coords(nrows) - stores x-coordinates from input files
26!> - y_coords(nrows) - stores y-coordinates from input files (3D case only)
27!>
28!> **File Reading Operations:**
29!> - Reads primitive variable data from multiple files with pattern:
30!> `prim.<file_number>.00.<timestep>.dat` where timestep uses `zeros_default` padding
31!> - Files are read from directory specified by `init_dir` parameter
32!> - Supports 1D, 2D, and 3D computational domains
33!>
34!> **Grid Structure Detection:**
35!> - 1D/2D: Counts lines in first file to determine xRows
36!> - 3D: Analyzes coordinate patterns to determine xRows and yRows structure
37!>
38!> **MPI Domain Mapping:**
39!> - Calculates global_offset_x and global_offset_y for MPI subdomain positioning
40!> - Maps file coordinates to local computational grid coordinates
41!>
42!> **Data Assignment:**
43!> - Populates q_prim_vf primitive variable arrays with file data
44!> - Handles momentum component indexing with special treatment for eqn_idx%mom%end
45!> - Sets eqn_idx%mom%end component to zero for 2D/3D cases
46!>
47!> **State Management:**
48!> - Uses files_loaded flag to prevent redundant file operations
49!> - Preserves data across multiple macro calls within same simulation
50!>
51!> @note File pattern uses `zeros_default` parameter (default: "000000") for timestep padding
52!> @note Directory path is hardcoded in `init_dir` parameter - modify as needed
53!> @warning Aborts execution if file reading errors occur.
54
55# 56 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
56
57# 194 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 205 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
60# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
61# 1 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp" 1
62# 5 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
63
64# 72 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
65# 8 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
66# 1 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp" 1
67# 32 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 395 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
70# 9 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
71# 1 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp" 1
72# 66 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 186 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
75# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
76# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
77# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
78# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
79# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96
97# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98
99# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
100
101# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
102
103# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
104! New line at end of file is required for FYPP
105# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
106# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
107# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
108# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
110# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
112# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113
114# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
116# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
117
118# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
119
120# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121
122# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123
124# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
125
126# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127
128# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
129
130# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
131
132# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
133! New line at end of file is required for FYPP
134# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
135
136# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183
184# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
185
186# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
187# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
188
189# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
190
191# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
192
193# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
194
195# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
196
197# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
198
199# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
200
201# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
202
203# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
204
205# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
206
207# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
208
209# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
210
211# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
212! New line at end of file is required for FYPP
213# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
214# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
215# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
216# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
217# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
218# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
219# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
220# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
221
222# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
223# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
224# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
225
226# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
227
228# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
229
230# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
231
232# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
233
234# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
235
236# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
237
238# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
239
240# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
241! New line at end of file is required for FYPP
242# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
243
244# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273
274# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
275
276# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
277
278# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
279
280# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
281
282# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
283
284# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
285
286# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
287
288# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
289
290# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
291
292# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
293
294# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
295
296# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
297
298# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
299! New line at end of file is required for FYPP
300# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
301
302! GPU parallel region (scalar reductions, maxval/minval)
303# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
304
305! GPU parallel loop over threads (most common GPU macro)
306# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308! Required closing for GPU_PARALLEL_LOOP
309# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
310
311! Mark routine for device compilation
312# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314! Declare device-resident data
315# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
316
317! Inner loop within a GPU parallel region
318# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320! Scoped GPU data region
321# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
322
323! Host code with device pointers (for MPI with GPU buffers)
324# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326! Allocate device memory (unscoped)
327# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
328
329! Free device memory
330# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332! Atomic operation on device
333# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334
335! End atomic capture block
336# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
337
338! Copy data between host and device
339# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
340
341! Synchronization barrier
342# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
343
344! Import GPU library module (openacc or omp_lib)
345# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
346
347! Emit code only for AMD compiler
348# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
349
350! Emit code for non-Cray compilers
351# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
352
353! Emit code only for Cray compiler
354# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
355
356! Emit code for non-NVIDIA compilers
357# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
358
359# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
360# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
361! New line at end of file is required for FYPP
362# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
363
364# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
365
366! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
367! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
368! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
369# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
370
371! Allocate and create GPU device memory
372# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
373
374! Free GPU device memory and deallocate
375# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
376
377! Cray-specific GPU pointer setup for vector fields
378# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
379
380! Cray-specific GPU pointer setup for scalar fields
381# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
382
383! Cray-specific GPU pointer setup for acoustic source spatials
384# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
385
386# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
387
388# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
389! New line at end of file is required for FYPP
390# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
391
392!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
393module m_icpp_patches
394
395 use m_patch_geometries
396 use m_model ! Subroutine(s) related to STL files
397 use m_derived_types ! Definitions of the derived types
398 use m_global_parameters
399 use m_constants, only: max_2d_fourier_modes, max_sph_harm_degree, small_radius, model_eqns_4eq
400 use m_helper_basic
401 use m_helper
402 use m_mpi_common
403 use m_assign_variables
404 use m_mpi_common
405 use m_variables_conversion
406
407 implicit none
408
409 private; public :: s_apply_icpp_patches
410
411 real(wp) :: x_centroid, y_centroid, z_centroid
412 real(wp) :: length_x, length_y, length_z
413 integer :: smooth_patch_id
414 real(wp) :: smooth_coeff !< Smoothing coefficient (mirrors ic_patch_parameters%smooth_coeff)
415 real(wp) :: eta !< Pseudo volume fraction for patch boundary smoothing
416 real(wp) :: cart_y, cart_z
417 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
418 character(len=5) :: istr !< string to store int to string result for error checking
419
420contains
421
422 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
423 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
424
425 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
426
427#ifdef MFC_MIXED_PRECISION
428 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
429#else
430 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
431#endif
432 integer :: i
433 ! Load STL/OBJ models once into the shared flat arrays if any patch is an STL/OBJ model (geometry 21)
434
435 do i = 1, num_patches
436 if (patch_icpp(i)%geometry == 21) then
437 call s_instantiate_stl_models()
438 exit
439 end if
440 end do
441 ! 3D Patch Geometries
442
443 if (p > 0) then
444 do i = 1, num_patches
445 if (proc_rank == 0) then
446 print *, 'Processing patch', i
447 end if
448
449 !> ICPP Patches
450 !> @{
451 ! Spherical patch
452 if (patch_icpp(i)%geometry == 8) then
453 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
454 ! Cuboidal patch
455 else if (patch_icpp(i)%geometry == 9) then
456 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
457 ! Cylindrical patch
458 else if (patch_icpp(i)%geometry == 10) then
459 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
460 ! Swept plane patch
461 else if (patch_icpp(i)%geometry == 11) then
462 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
463 ! Ellipsoidal patch
464 else if (patch_icpp(i)%geometry == 12) then
465 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
466 ! 3D spherical harmonic patch
467 else if (patch_icpp(i)%geometry == 14) then
468 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
469 ! 3D Modified circular patch
470 else if (patch_icpp(i)%geometry == 19) then
471 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
472 ! 3D STL patch
473 else if (patch_icpp(i)%geometry == 21) then
474 call s_icpp_model(i, patch_id_fp, q_prim_vf)
475 end if
476 end do
477 !> @}
478
479 ! 2D Patch Geometries
480 else if (n > 0) then
481 do i = 1, num_patches
482 if (proc_rank == 0) then
483 print *, 'Processing patch', i
484 end if
485
486 !> ICPP Patches
487 !> @{
488 ! Circular patch
489 if (patch_icpp(i)%geometry == 2) then
490 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
491 ! Rectangular patch
492 else if (patch_icpp(i)%geometry == 3) then
493 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
494 ! Swept line patch
495 else if (patch_icpp(i)%geometry == 4) then
496 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
497 ! Elliptical patch
498 else if (patch_icpp(i)%geometry == 5) then
499 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
500 ! Unimplemented patch (formerly isentropic vortex)
501 else if (patch_icpp(i)%geometry == 6) then
502 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
503 & // 'which no longer exists. See Examples. Exiting.')
504 ! 2D modal (Fourier) patch
505 else if (patch_icpp(i)%geometry == 13) then
506 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
507 ! Spiral patch
508 else if (patch_icpp(i)%geometry == 17) then
509 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
510 ! Modified circular patch
511 else if (patch_icpp(i)%geometry == 18) then
512 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
513 ! TaylorGreen vortex patch
514 else if (patch_icpp(i)%geometry == 20) then
515 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
516 ! STL patch
517 else if (patch_icpp(i)%geometry == 21) then
518 call s_icpp_model(i, patch_id_fp, q_prim_vf)
519 end if
520 !> @}
521 end do
522
523 ! 1D Patch Geometries
524 else
525 do i = 1, num_patches
526 if (proc_rank == 0) then
527 print *, 'Processing patch', i
528 end if
529
530 ! Line segment patch
531 if (patch_icpp(i)%geometry == 1) then
532 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
533 ! 1d analytical
534 else if (patch_icpp(i)%geometry == 16) then
535 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
536 end if
537 end do
538 end if
539
540 end subroutine s_apply_icpp_patches
541
542 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
543 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
544 !! patch DOES NOT allow for the smearing of its boundaries.
545 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
546
547 integer, intent(in) :: patch_id
548
549#ifdef MFC_MIXED_PRECISION
550 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
551#else
552 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
553#endif
554 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
555
556 ! Generic loop iterators
557 integer :: i, j, k
558
559 ! Placeholders for the cell boundary values
560 real(wp) :: pi_inf, gamma, lit_gamma
561
562 integer :: xRows, yRows, nRows, iix, iiy, max_files
563# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
564 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
565# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
566 real(wp) :: x_len, x_step, y_len, y_step
567# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
568 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
569# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
570 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
571# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
572 real(wp) :: delta_x, delta_y
573# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
574 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
575# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
576 character(len=200) :: errmsg
577# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
578 real(wp), allocatable :: stored_values(:,:,:)
579# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
580 real(wp), allocatable :: x_coords(:), y_coords(:)
581# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
582 logical :: files_loaded = .false.
583# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
584 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
585# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
586 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
587# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
588 character(len=20) :: file_num_str !< For storing the file number as a string
589# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
590 character(len=20) :: zeros_part !< For the trailing zeros part
591# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
592 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
593 ! Place any declaration of intermediate variables here
594# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
595 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
596
597 pi_inf = pi_infs(1)
598 gamma = gammas(1)
599 lit_gamma = gs_min(1)
600 j = 0
601 k = 0
602
603 ! Transferring the line segment's centroid and length information
604 x_centroid = patch_icpp(patch_id)%x_centroid
605 length_x = patch_icpp(patch_id)%length_x
606
607 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
608 x_boundary%beg = x_centroid - 0.5_wp*length_x
609 x_boundary%end = x_centroid + 0.5_wp*length_x
610
611 ! Set eta=1 (no smoothing for this patch type)
612 eta = 1._wp
613
614 ! Assign patch vars if cell is covered and patch has write permission
615 do i = 0, m
616 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, &
617 & 0, 0))) then
618 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
619
620
621
622 ! check if this should load a hardcoded patch
623 if (patch_icpp(patch_id)%hcid /= dflt_int) then
624 select case (patch_icpp(patch_id)%hcid)
625# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
626 case (150) ! 1D Smooth Alfven Case for MHD
627# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
628 ! velocity
629# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
630 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
631# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
632 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
633# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
634
635# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
636 ! magnetic field
637# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
638 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
639# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
640 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
641# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
642 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
643# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
644 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
645# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
646 ! SDtoolbox)
647# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
648 if (.not. files_loaded) then
649# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
650 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
651# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
652 do f = 1, max_files
653# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
654 write (file_num_str, '(I0)') f
655# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
656 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
657# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
658 end do
659# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
660
661# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
662 ! Common file reading setup
663# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
664 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
665# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
666 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
667# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
668
669# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
670 select case (num_dims)
671# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
672 case (1, 2) ! 1D and 2D cases are similar
673# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
674 ! Count lines
675# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
676 line_count = 0
677# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
678 do
679# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
680 read (unit2, *, iostat=ios2) dummy_x, dummy_y
681# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
682 if (ios2 /= 0) exit
683# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
684 line_count = line_count + 1
685# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
686 end do
687# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
688 close (unit2)
689# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
690
691# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
692 xrows = line_count
693# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
694 yrows = 1
695# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
696 index_x = 0
697# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
698 if (num_dims == 2) index_x = i
699# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
700#ifdef MFC_DEBUG
701# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
702 block
703# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
704 use iso_fortran_env, only: output_unit
705# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
706
707# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
708 print *, 'm_icpp_patches.fpp:212: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
709# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
710
711# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
712 call flush (output_unit)
713# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
714 end block
715# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
716#endif
717# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
718 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
719# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
720
721# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
722
723# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
724
725# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
726#if defined(MFC_OpenACC)
727# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
728!$acc enter data create(x_coords, stored_values)
729# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
730#elif defined(MFC_OpenMP)
731# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
732!$omp target enter data map(always,alloc:x_coords, stored_values)
733# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
734#endif
735# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
736
737# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
738 ! Read data from all files
739# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
740 do f = 1, max_files
741# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
742 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
743# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
744 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
745# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
746
747# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
748 do iter = 1, xrows
749# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
750 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
751# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
752 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
753# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
754 end do
755# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
756 close (unit)
757# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
758 end do
759# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
760
761# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
762 ! Calculate offsets
763# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
764 domain_xstart = x_coords(1)
765# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
766 x_step = x_cc(1) - x_cc(0)
767# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
768 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)
769# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
770 global_offset_x = nint(abs(delta_x)/x_step)
771# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
772 case (3) ! 3D case - determine grid structure
773# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
774 ! Find yRows by counting rows with same x
775# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
776 read (unit2, *, iostat=ios2) x0, y0, dummy_z
777# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
778 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
779# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
780
781# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
782 yrows = 1
783# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
784 do
785# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
786 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
787# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
788 if (ios2 /= 0) exit
789# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
790 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
791# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
792 yrows = yrows + 1
793# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
794 else
795# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
796 exit
797# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
798 end if
799# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
800 end do
801# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
802 close (unit2)
803# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
804
805# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
806 ! Count total rows
807# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
808 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
809# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
810 nrows = 0
811# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
812 do
813# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
814 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
815# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
816 if (ios2 /= 0) exit
817# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
818 nrows = nrows + 1
819# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
820 end do
821# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
822 close (unit2)
823# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
824
825# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
826 xrows = nrows/yrows
827# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
828#ifdef MFC_DEBUG
829# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
830 block
831# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
832 use iso_fortran_env, only: output_unit
833# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
834
835# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
836 print *, 'm_icpp_patches.fpp:212: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
837# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
838
839# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
840 call flush (output_unit)
841# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
842 end block
843# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
844#endif
845# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
846 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
847# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
848
849# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
850
851# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
852
853# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
854
855# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
856#if defined(MFC_OpenACC)
857# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
858!$acc enter data create(x_coords, y_coords, stored_values)
859# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
860#elif defined(MFC_OpenMP)
861# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
862!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
863# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
864#endif
865# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
866 index_x = i
867# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
868 index_y = j
869# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
870
871# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
872 ! Read all files
873# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
874 do f = 1, max_files
875# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
876 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
877# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
878 if (ios /= 0) then
879# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
880 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
881# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
882 cycle
883# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
884 end if
885# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
886
887# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
888 iter = 0
889# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
890 do iix = 1, xrows
891# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
892 do iiy = 1, yrows
893# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
894 iter = iter + 1
895# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
896 if (f == 1) then
897# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
898 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
899# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
900 else
901# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
902 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
903# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
904 end if
905# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
906 if (ios /= 0) call s_mpi_abort("Error reading data")
907# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
908 end do
909# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
910 end do
911# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
912 close (unit)
913# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
914 end do
915# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
916
917# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
918 ! Calculate offsets
919# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
920 x_step = x_cc(1) - x_cc(0)
921# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
922 y_step = y_cc(1) - y_cc(0)
923# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
924 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
925# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
926 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
927# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
928 global_offset_x = nint(abs(delta_x)/x_step)
929# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
930 global_offset_y = nint(abs(delta_y)/y_step)
931# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
932 end select
933# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
934
935# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
936 files_loaded = .true.
937# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
938 end if
939# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
940
941# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
942 ! Data assignment
943# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
944 select case (num_dims)
945# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
946 case (1)
947# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
948 idx = i + 1 + global_offset_x
949# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
950 do f = 1, sys_size
951# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
952 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
953# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
954 end do
955# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
956 case (2)
957# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
958 idx = i + 1 + global_offset_x - index_x
959# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
960 do f = 1, sys_size - 1
961# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
962 jump = merge(1, 0, f >= eqn_idx%mom%end)
963# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
964 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
965# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
966 end do
967# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
968 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
969# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
970 case (3)
971# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
972 idx = i + 1 + global_offset_x - index_x
973# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
974 idy = j + 1 + global_offset_y - index_y
975# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
976 do f = 1, sys_size - 1
977# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
978 jump = merge(1, 0, f >= eqn_idx%mom%end)
979# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
980 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
981# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
982 end do
983# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
984 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
985# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
986 end select
987# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
988 case (180) ! Shu-Osher problem
989# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
990 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
991# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
992 ! 0.2*sin(5*x)"
993# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
994 if (patch_id == 2) then
995# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
996 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
997# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
998 end if
999# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1000 case (181) ! Titarev-Torro problem
1001# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1002 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
1003# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1004 ! "1 + 0.1*sin(20*x*pi)"
1005# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1006 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1007# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1008 case (182) ! Multi-component diffusion
1009# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1010 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1011# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1012 x_mid_diffu = 0.05_wp/2.0_wp
1013# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1014 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1015# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1016 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1017# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1018 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1019# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1020 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1021# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1022 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
1023# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1024
1025# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1026 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1027# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1028 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1029# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1030 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1031# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1032 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1033# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1034
1035# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1036 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
1037# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1038 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
1039# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1040 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
1041# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1042 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
1043# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1044
1045# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1046 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1047# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1048
1049# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1050 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1051# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1052
1053# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1054 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1055# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1056 case(191) ! 1D Dual Isothermal case
1057# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1058 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
1059# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1060 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1061# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1062 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
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 if (x_cc(i) <= 0.025_wp) then
1067# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1068 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
1069# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1070 else
1071# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1072 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
1073# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1074 end if
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 molar_mass_inv = 1.0_wp/2.01588_wp
1079# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1080 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1081# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1082 case default
1083# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1084 call s_int_to_str(patch_id, istr)
1085# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1086 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1087# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1088 end select
1089 end if
1090
1091 ! Updating the patch identities bookkeeping variable
1092 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1093 end if
1094 end do
1095 if (allocated(stored_values)) then
1096# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1097#ifdef MFC_DEBUG
1098# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1099 block
1100# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1101 use iso_fortran_env, only: output_unit
1102# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1103
1104# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1105 print *, 'm_icpp_patches.fpp:219: ', '@:DEALLOCATE(stored_values)'
1106# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1107
1108# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1109 call flush (output_unit)
1110# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1111 end block
1112# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1113#endif
1114# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1115
1116# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1117#if defined(MFC_OpenACC)
1118# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1119!$acc exit data delete(stored_values)
1120# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1121#elif defined(MFC_OpenMP)
1122# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1123!$omp target exit data map(release:stored_values)
1124# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1125#endif
1126# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1127 deallocate (stored_values)
1128# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1129#ifdef MFC_DEBUG
1130# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1131 block
1132# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1133 use iso_fortran_env, only: output_unit
1134# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1135
1136# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1137 print *, 'm_icpp_patches.fpp:219: ', '@:DEALLOCATE(x_coords)'
1138# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1139
1140# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1141 call flush (output_unit)
1142# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1143 end block
1144# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1145#endif
1146# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1147
1148# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1149#if defined(MFC_OpenACC)
1150# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1151!$acc exit data delete(x_coords)
1152# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1153#elif defined(MFC_OpenMP)
1154# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1155!$omp target exit data map(release:x_coords)
1156# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1157#endif
1158# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1159 deallocate (x_coords)
1160# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1161 end if
1162# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1163
1164# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1165 if (allocated(y_coords)) then
1166# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1167#ifdef MFC_DEBUG
1168# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1169 block
1170# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1171 use iso_fortran_env, only: output_unit
1172# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1173
1174# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1175 print *, 'm_icpp_patches.fpp:219: ', '@:DEALLOCATE(y_coords)'
1176# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1177
1178# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1179 call flush (output_unit)
1180# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1181 end block
1182# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1183#endif
1184# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1185
1186# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1187#if defined(MFC_OpenACC)
1188# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1189!$acc exit data delete(y_coords)
1190# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1191#elif defined(MFC_OpenMP)
1192# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1193!$omp target exit data map(release:y_coords)
1194# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1195#endif
1196# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1197 deallocate (y_coords)
1198# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1199 end if
1200
1201 end subroutine s_icpp_line_segment
1202
1203 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1204 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1205 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1206
1207 integer, intent(in) :: patch_id
1208
1209#ifdef MFC_MIXED_PRECISION
1210 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1211#else
1212 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1213#endif
1214 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1215 integer :: i, j, k !< Generic loop iterators
1216 real(wp) :: th, thickness, nturns, mya
1217 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1218
1219 integer :: xrows, yrows, nrows, iix, iiy, max_files
1220# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1221 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1222# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1223 real(wp) :: x_len, x_step, y_len, y_step
1224# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1225 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1226# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1227 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1228# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1229 real(wp) :: delta_x, delta_y
1230# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1231 character(len=100), dimension(sys_size) :: filenames !< Arrays to store all data from files
1232# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1233 character(len=200) :: errmsg
1234# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1235 real(wp), allocatable :: stored_values(:,:,:)
1236# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237 real(wp), allocatable :: x_coords(:), y_coords(:)
1238# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 logical :: files_loaded = .false.
1240# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1241 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1242# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1243 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
1244# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1245 character(len=20) :: file_num_str !< For storing the file number as a string
1246# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1247 character(len=20) :: zeros_part !< For the trailing zeros part
1248# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1249 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
1250 ! Place any declaration of intermediate variables here
1251# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1252 real(wp) :: eps, eps_mhd, c_mhd
1253# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1254 real(wp) :: r, rmax, gam, umax, p0
1255# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1256 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1257# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1258 real(wp) :: factor
1259# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1260 real(wp) :: r0, alpha, r2
1261# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1262 real(wp) :: sina, cosa
1263# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1264 real(wp) :: r_sq
1265# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1266
1267# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1268 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
1269# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1270 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, t_facq, wq
1271# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1272 real(wp) :: rho_avg, rhou_avg, rhov_avg, e_avg
1273# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1274 real(wp) :: rhoq, pq, uq, vq, eq, vortex_eps
1275# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276 integer :: igq, jgq
1277# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278
1279# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280 ! # 291 - Shear/Thermal Layer Case
1281# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282 real(wp) :: delta_shear, u_max, u_mean
1283# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284 real(wp) :: t_wall, t_inf, p_atm, t_loc
1285# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 real(wp) :: delta_th, r_mix
1287# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288 real(wp) :: y_n2, y_o2, mw_n2, mw_o2
1289# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290 real(wp) :: bottom_blend_u, bottom_blend_t
1291# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292
1293# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1294 ! # 207
1295# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1296 real(wp) :: sigma, gauss1, gauss2
1297# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1298
1299# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1300 ! # 208
1301# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1302 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1303# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1304
1305# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1306 eps = 1.e-9_wp
1307
1308 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1309 x_centroid = patch_icpp(patch_id)%x_centroid
1310 y_centroid = patch_icpp(patch_id)%y_centroid
1311 mya = patch_icpp(patch_id)%radius
1312 thickness = patch_icpp(patch_id)%length_x
1313 nturns = patch_icpp(patch_id)%length_y
1314
1315 !
1316 logic_grid = 0
1317 do k = 0, int(m*91*nturns)
1318 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1319
1320 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1321 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1322
1323 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1324 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1325
1326 do j = 0, n; do i = 0, m
1327 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) &
1328 & < spiral_y_max)) then
1329 logic_grid(i, j, 0) = 1
1330 end if
1331 end do; end do
1332 end do
1333
1334 do j = 0, n
1335 do i = 0, m
1336 if ((logic_grid(i, j, 0) == 1)) then
1337 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1338
1339
1340 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1341 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1342# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1343 case (200) ! Two-fluid cubic interface
1344# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1345 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1346# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1347 ! Volume Fractions
1348# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1349 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
1350# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1351 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
1352# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1353 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
1354# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1355 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
1356# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1357 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
1358# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1359 end if
1360# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1361 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1362# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1363 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1364# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1365 rmax = 0.2_wp
1366# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1367
1368# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1369 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1370# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1371 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1372# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1373 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1374# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1375
1376# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1377 if (r < rmax) then
1378# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1379 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1380# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1381 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1382# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1383 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1384# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1385 else if (r < 2*rmax) then
1386# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1387 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1388# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1389 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1390# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1391 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
1392# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1393 else
1394# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1395 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1396# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1397 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1398# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1399 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1400# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1401 end if
1402# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1403 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1404# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1405 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1406# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1407 rmax = 0.2_wp
1408# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1409
1410# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1411 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1412# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1413 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1414# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1415 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1416# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1417
1418# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1419 if (r < rmax) then
1420# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1421 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1422# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1423 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1424# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1425 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1426# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1427 else if (r < 2*rmax) then
1428# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1429 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1430# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1431 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1432# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1433 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
1434# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1435 else
1436# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1437 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1438# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1439 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1440# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1441 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1442# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1443 end if
1444# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1445
1446# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1447 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
1448# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1449 case (204) ! Rayleigh-Taylor instability
1450# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1451 rhoh = 3._wp
1452# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1453 rhol = 1._wp
1454# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1455 pref = 1.e5_wp
1456# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1457 pint = pref
1458# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 h = 0.7_wp
1460# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461 lam = 0.2_wp
1462# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 wl = 2._wp*pi/lam
1464# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465 amp = 0.05_wp/wl
1466# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467
1468# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1470# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471
1472# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1474# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475
1476# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 if (alph < eps) alph = eps
1478# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479 if (alph > 1._wp - eps) alph = 1._wp - eps
1480# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481
1482# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 if (y_cc(j) > inth) then
1484# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1486# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1488# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1490# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1492# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1494# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 else
1496# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1498# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1499 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1500# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1501 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1502# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1503 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1504# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1505 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1506# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1507 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1508# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1509 end if
1510# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1511 case (205) ! 2D lung wave interaction problem
1512# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1513 h = 0.0_wp ! non dim origin y
1514# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1515 lam = 1.0_wp ! non dim lambda
1516# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1517 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1518# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1519
1520# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1521 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1522# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1523
1524# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1525 if (y_cc(j) > inth) then
1526# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1527 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1528# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1529 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1530# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1532# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1533 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1534# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1535 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1536# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1537 end if
1538# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1539 case (206) ! 2D lung wave interaction problem - horizontal domain
1540# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1541 h = 0.0_wp ! non dim origin y
1542# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1543 lam = 1.0_wp ! non dim lambda
1544# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1545 amp = patch_icpp(patch_id)%a(2)
1546# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1547
1548# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1549 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1550# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1551
1552# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1553 if (x_cc(i) > intl) then ! this is the liquid
1554# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1555 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1556# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1557 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1558# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1559 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1560# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1561 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1562# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1563 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1564# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1565 end if
1566# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1567 case (207) ! Kelvin Helmholtz Instability
1568# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1569 sigma = 0.05_wp/sqrt(2.0_wp)
1570# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1571 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1572# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1573 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1574# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1575 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
1576# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1577 case (208) ! Richtmeyer Meshkov Instability
1578# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1579 lam = 1.0_wp
1580# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1581 eps = 1.0e-6_wp
1582# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1583 ei = 5.0_wp
1584# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1585 ! Smoothening function to smooth out sharp discontinuity in the interface
1586# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1587 if (x_cc(i) <= 0.7_wp*lam) then
1588# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1589 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1590# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1591 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1592# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1593 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1594# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1595 alpha_sf6 = 1.0_wp - alpha_air
1596# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1597 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
1598# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1599 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
1600# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1601 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
1602# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1603 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
1604# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1605 end if
1606# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1607 case (250) ! MHD Orszag-Tang vortex
1608# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1609 ! 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),
1610# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1611 ! sin(4*pi*x)/sqrt(4*pi), 0)
1612# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1613
1614# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1615 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1616# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1617 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1618# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1619
1620# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1621 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1622# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1623 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1624# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1625 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1626# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1627 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1628# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1629 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
1630# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1631 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
1632# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1633 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1634# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1635 ! Linear interpolation between r=0.08 and r=1.0
1636# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1637 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1638# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1639 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1640# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1641 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1642# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1643 else
1644# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1645 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
1646# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1647 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
1648# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1649 end if
1650# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1651
1652# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1653 ! case 252 is for the 2D MHD Rotor problem
1654# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1655 case (252) ! 2D MHD Rotor Problem
1656# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1657 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1658# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1659 !
1660# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1661 ! 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
1662# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1663 ! velocity w=20, giving v_tan=2 at r=0.1
1664# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1665
1666# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1667 ! Calculate distance squared from the center
1668# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1669 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1670# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1671
1672# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1673 ! inner radius of 0.1
1674# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1675 if (r_sq <= 0.1**2) then
1676# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1677 ! -- Inside the rotor -- Set density uniformly to 10
1678# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1679 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
1680# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1681
1682# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1683 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1684# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1685 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1686# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1687 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1688# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1689
1690# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1691 ! taper width of 0.015
1692# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1693 else if (r_sq <= 0.115**2) then
1694# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1695 ! linearly smooth the function between r = 0.1 and 0.115
1696# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1697 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1698# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1699
1700# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1701 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1702# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1703 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1704# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1705 end if
1706# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1707 case (253) ! MHD Smooth Magnetic Vortex
1708# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1709 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1710# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1711 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1712# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1713
1714# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1715 ! velocity
1716# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1717 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1718# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1719 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1720# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1721
1722# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1723 ! magnetic field
1724# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1725 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1726# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1727 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1728# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1729
1730# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1731 ! pressure
1732# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1733 q_prim_vf(eqn_idx%E)%sf(i, j, &
1734# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1735 & 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)
1736# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1737 case (260) ! Gaussian Divergence Pulse
1738# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1739 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1740# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1741 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1742# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1743 ! initialized to zero everywhere.
1744# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1745
1746# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1747 eps_mhd = patch_icpp(patch_id)%a(2)
1748# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1749 sigma = patch_icpp(patch_id)%a(3)
1750# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1751 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1752# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1753
1754# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1755 ! B-field
1756# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1757 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1758# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1759 case (261) ! Blob
1760# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1761 r0 = 1._wp/sqrt(8._wp)
1762# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1763 r2 = x_cc(i)**2 + y_cc(j)**2
1764# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1765 r = sqrt(r2)
1766# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1767 alpha = r/r0
1768# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1769 if (alpha < 1) then
1770# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1771 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
1772# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1773 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
1774# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1775 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1776# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1777 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
1778# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1779 end if
1780# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1781 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
1782# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1783 ! rotate by \alpha = atan(2)
1784# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1785 alpha = atan(2._wp)
1786# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1787 cosa = cos(alpha)
1788# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1789 sina = sin(alpha)
1790# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1791 ! projection along shock normal
1792# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1793 r = x_cc(i)*cosa + y_cc(j)*sina
1794# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1795
1796# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1797 if (r <= 0.5_wp) then
1798# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1799 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1800# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1801 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1802# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1803 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
1804# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1805 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
1806# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1807 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
1808# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1809 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1810# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1811 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1812# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1813 else
1814# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1815 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1816# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1817 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1818# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1819 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
1820# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1821 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
1822# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1823 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
1824# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1825 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
1826# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1827 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
1828# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1829 end if
1830# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1831 ! v^z and B^z remain zero by default
1832# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1833 case (270) ! 2D extrusion of 1D profile from external data
1834# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1835 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1836# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1837 if (.not. files_loaded) then
1838# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1839 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1840# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1841 do f = 1, max_files
1842# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1843 write (file_num_str, '(I0)') f
1844# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1845 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
1846# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1847 end do
1848# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1849
1850# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1851 ! Common file reading setup
1852# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1853 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1854# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1855 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
1856# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1857
1858# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1859 select case (num_dims)
1860# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1861 case (1, 2) ! 1D and 2D cases are similar
1862# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1863 ! Count lines
1864# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1865 line_count = 0
1866# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1867 do
1868# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1869 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1870# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1871 if (ios2 /= 0) exit
1872# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1873 line_count = line_count + 1
1874# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1875 end do
1876# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1877 close (unit2)
1878# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1879
1880# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1881 xrows = line_count
1882# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1883 yrows = 1
1884# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1885 index_x = 0
1886# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1887 if (num_dims == 2) index_x = i
1888# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1889#ifdef MFC_DEBUG
1890# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1891 block
1892# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1893 use iso_fortran_env, only: output_unit
1894# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1895
1896# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1897 print *, 'm_icpp_patches.fpp:275: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1898# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1899
1900# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1901 call flush (output_unit)
1902# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1903 end block
1904# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1905#endif
1906# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1907 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1908# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1909
1910# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1911
1912# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1913
1914# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1915#if defined(MFC_OpenACC)
1916# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1917!$acc enter data create(x_coords, stored_values)
1918# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1919#elif defined(MFC_OpenMP)
1920# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1921!$omp target enter data map(always,alloc:x_coords, stored_values)
1922# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1923#endif
1924# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1925
1926# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1927 ! Read data from all files
1928# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1929 do f = 1, max_files
1930# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1931 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1932# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1933 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
1934# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1935
1936# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1937 do iter = 1, xrows
1938# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1939 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
1940# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1941 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
1942# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1943 end do
1944# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1945 close (unit)
1946# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1947 end do
1948# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1949
1950# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1951 ! Calculate offsets
1952# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1953 domain_xstart = x_coords(1)
1954# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1955 x_step = x_cc(1) - x_cc(0)
1956# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1957 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)
1958# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1959 global_offset_x = nint(abs(delta_x)/x_step)
1960# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1961 case (3) ! 3D case - determine grid structure
1962# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1963 ! Find yRows by counting rows with same x
1964# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1965 read (unit2, *, iostat=ios2) x0, y0, dummy_z
1966# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1967 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
1968# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1969
1970# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1971 yrows = 1
1972# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1973 do
1974# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1975 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1976# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1977 if (ios2 /= 0) exit
1978# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1979 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
1980# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1981 yrows = yrows + 1
1982# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1983 else
1984# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1985 exit
1986# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1987 end if
1988# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1989 end do
1990# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1991 close (unit2)
1992# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1993
1994# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1995 ! Count total rows
1996# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1997 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1998# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1999 nrows = 0
2000# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2001 do
2002# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2003 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2004# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2005 if (ios2 /= 0) exit
2006# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2007 nrows = nrows + 1
2008# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2009 end do
2010# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2011 close (unit2)
2012# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2013
2014# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2015 xrows = nrows/yrows
2016# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2017#ifdef MFC_DEBUG
2018# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2019 block
2020# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2021 use iso_fortran_env, only: output_unit
2022# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2023
2024# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2025 print *, 'm_icpp_patches.fpp:275: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2026# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2027
2028# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2029 call flush (output_unit)
2030# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2031 end block
2032# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2033#endif
2034# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2035 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2036# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2037
2038# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2039
2040# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2041
2042# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2043
2044# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2045#if defined(MFC_OpenACC)
2046# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2047!$acc enter data create(x_coords, y_coords, stored_values)
2048# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2049#elif defined(MFC_OpenMP)
2050# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2051!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2052# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2053#endif
2054# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2055 index_x = i
2056# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2057 index_y = j
2058# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2059
2060# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2061 ! Read all files
2062# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2063 do f = 1, max_files
2064# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2065 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2066# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2067 if (ios /= 0) then
2068# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2069 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2070# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2071 cycle
2072# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2073 end if
2074# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2075
2076# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2077 iter = 0
2078# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2079 do iix = 1, xrows
2080# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2081 do iiy = 1, yrows
2082# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2083 iter = iter + 1
2084# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2085 if (f == 1) then
2086# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2087 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2088# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2089 else
2090# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2091 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2092# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2093 end if
2094# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2095 if (ios /= 0) call s_mpi_abort("Error reading data")
2096# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2097 end do
2098# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2099 end do
2100# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2101 close (unit)
2102# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2103 end do
2104# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2105
2106# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2107 ! Calculate offsets
2108# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2109 x_step = x_cc(1) - x_cc(0)
2110# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2111 y_step = y_cc(1) - y_cc(0)
2112# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2113 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2114# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2115 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2116# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2117 global_offset_x = nint(abs(delta_x)/x_step)
2118# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2119 global_offset_y = nint(abs(delta_y)/y_step)
2120# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2121 end select
2122# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2123
2124# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2125 files_loaded = .true.
2126# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2127 end if
2128# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2129
2130# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2131 ! Data assignment
2132# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2133 select case (num_dims)
2134# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2135 case (1)
2136# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2137 idx = i + 1 + global_offset_x
2138# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2139 do f = 1, sys_size
2140# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2141 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2142# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2143 end do
2144# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2145 case (2)
2146# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2147 idx = i + 1 + global_offset_x - index_x
2148# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2149 do f = 1, sys_size - 1
2150# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2151 jump = merge(1, 0, f >= eqn_idx%mom%end)
2152# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2153 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2154# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2155 end do
2156# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2157 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2158# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2159 case (3)
2160# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2161 idx = i + 1 + global_offset_x - index_x
2162# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2163 idy = j + 1 + global_offset_y - index_y
2164# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2165 do f = 1, sys_size - 1
2166# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2167 jump = merge(1, 0, f >= eqn_idx%mom%end)
2168# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2169 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2170# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2171 end do
2172# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2173 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2174# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2175 end select
2176# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2177 case (280) ! Isentropic vortex
2178# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2179 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
2180# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2181 ! geometry 2
2182# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2183 if (patch_id == 1) then
2184# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2185 q_prim_vf(eqn_idx%E)%sf(i, j, &
2186# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2187 & 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) &
2188# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2189 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
2190# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2191 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2192# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2193 & 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) &
2194# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2195 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
2196# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2197 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2198# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2199 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
2200# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2201 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2202# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2203 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2204# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2205 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
2206# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2207 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2208# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2209 end if
2210# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2211 case (281) ! Acoustic pulse
2212# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2213 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
2214# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2215 ! geometry 2
2216# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2217 if (patch_id == 2) then
2218# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2219 q_prim_vf(eqn_idx%E)%sf(i, j, &
2220# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2221 & 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))
2222# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2223 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2224# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2225 & 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))
2226# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2227 end if
2228# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2229 case (282) ! Zero-circulation vortex
2230# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2231 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
2232# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2233 ! geometry 2
2234# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2235 if (patch_id == 2) then
2236# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2237 q_prim_vf(eqn_idx%E)%sf(i, j, &
2238# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2239 & 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))
2240# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2241 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2242# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2243 & 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))
2244# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2245 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2246# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2247 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2248# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2249 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2250# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2251 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2252# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2253 end if
2254# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2255 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
2256# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2257 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
2258# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2259 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
2260# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2261 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
2262# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2263 ! patch_icpp(patch_id)%epsilon; defaults to 5.
2264# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2265 if (patch_id == 1) then
2266# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2267 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
2268# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2269 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
2270# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2271 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
2272# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2273 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
2274# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2275 do igq = 1, 3
2276# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2277 do jgq = 1, 3
2278# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2279 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
2280# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2281 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
2282# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2283 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
2284# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2285 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
2286# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2287 wq = gauss_w(igq)*gauss_w(jgq)
2288# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2289 rhoq = t_facq**1.4_wp
2290# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2291 pq = t_facq**2.4_wp
2292# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2293 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2294# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2295 & - r2q)
2296# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2297 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2298# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2299 & - r2q)
2300# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2301 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
2302# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2303 rho_avg = rho_avg + wq*rhoq
2304# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2305 rhou_avg = rhou_avg + wq*(rhoq*uq)
2306# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2307 rhov_avg = rhov_avg + wq*(rhoq*vq)
2308# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2309 e_avg = e_avg + wq*eq
2310# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2311 end do
2312# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2313 end do
2314# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2315 rho_avg = rho_avg*0.25_wp
2316# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2317 rhou_avg = rhou_avg*0.25_wp
2318# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2319 rhov_avg = rhov_avg*0.25_wp
2320# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2321 e_avg = e_avg*0.25_wp
2322# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2323 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
2324# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2325 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
2326# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2327 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
2328# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2329 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
2330# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2331 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
2332# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2333 end if
2334# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2335 case (291) ! Isothermal Flat Plate
2336# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2337 t_inf = 1125.0_wp
2338# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2339 t_wall = 600.0_wp
2340# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2341 p_atm = 101325.0_wp
2342# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2343
2344# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2345 ! Boundary/Shear Layer thicknesses
2346# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2347 delta_th = 0.0003_wp ! Thermal BL thickness
2348# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2349 delta_shear = 8e-3_wp ! Velocity BL thickness
2350# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2351
2352# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2353 u_max = 50.0_wp ! Freestream Velocity (m/s)
2354# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2355
2356# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2357 mw_n2 = 28.0134e-3_wp
2358# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2359 mw_o2 = 31.999e-3_wp
2360# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361 y_n2 = 0.767_wp
2362# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363 y_o2 = 0.233_wp
2364# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
2366# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367 bottom_blend_u = tanh(y_cc(j)/delta_shear)
2368# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369 bottom_blend_t = tanh(y_cc(j)/delta_th)
2370# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 u_mean = u_max*bottom_blend_u
2372# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
2374# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
2376# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
2378# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2380# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
2382# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
2384# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
2386# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387 case default
2388# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2389 if (proc_rank == 0) then
2390# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2391 call s_int_to_str(patch_id, istr)
2392# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2393 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
2394# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2395 end if
2396# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2397 end select
2398 end if
2399
2400 ! Updating the patch identities bookkeeping variable
2401 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2402 end if
2403 end do
2404 end do
2405 if (allocated(stored_values)) then
2406# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2407#ifdef MFC_DEBUG
2408# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2409 block
2410# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2411 use iso_fortran_env, only: output_unit
2412# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2413
2414# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2415 print *, 'm_icpp_patches.fpp:283: ', '@:DEALLOCATE(stored_values)'
2416# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2417
2418# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2419 call flush (output_unit)
2420# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2421 end block
2422# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2423#endif
2424# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2425
2426# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2427#if defined(MFC_OpenACC)
2428# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2429!$acc exit data delete(stored_values)
2430# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2431#elif defined(MFC_OpenMP)
2432# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2433!$omp target exit data map(release:stored_values)
2434# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2435#endif
2436# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2437 deallocate (stored_values)
2438# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2439#ifdef MFC_DEBUG
2440# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2441 block
2442# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2443 use iso_fortran_env, only: output_unit
2444# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2445
2446# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2447 print *, 'm_icpp_patches.fpp:283: ', '@:DEALLOCATE(x_coords)'
2448# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2449
2450# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2451 call flush (output_unit)
2452# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2453 end block
2454# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2455#endif
2456# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2457
2458# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2459#if defined(MFC_OpenACC)
2460# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2461!$acc exit data delete(x_coords)
2462# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2463#elif defined(MFC_OpenMP)
2464# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2465!$omp target exit data map(release:x_coords)
2466# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2467#endif
2468# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2469 deallocate (x_coords)
2470# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2471 end if
2472# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2473
2474# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2475 if (allocated(y_coords)) then
2476# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2477#ifdef MFC_DEBUG
2478# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2479 block
2480# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2481 use iso_fortran_env, only: output_unit
2482# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2483
2484# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2485 print *, 'm_icpp_patches.fpp:283: ', '@:DEALLOCATE(y_coords)'
2486# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2487
2488# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2489 call flush (output_unit)
2490# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2491 end block
2492# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2493#endif
2494# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2495
2496# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2497#if defined(MFC_OpenACC)
2498# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2499!$acc exit data delete(y_coords)
2500# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2501#elif defined(MFC_OpenMP)
2502# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2503!$omp target exit data map(release:y_coords)
2504# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2505#endif
2506# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2507 deallocate (y_coords)
2508# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2509 end if
2510
2511 end subroutine s_icpp_spiral
2512
2513 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
2514 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
2515 !! its boundary.
2516 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2517
2518 integer, intent(in) :: patch_id
2519
2520#ifdef MFC_MIXED_PRECISION
2521 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2522#else
2523 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2524#endif
2525 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2526 real(wp) :: radius
2527 integer :: i, j, k !< Generic loop iterators
2528
2529 integer :: xRows, yRows, nRows, iix, iiy, max_files
2530# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2531 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2532# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2533 real(wp) :: x_len, x_step, y_len, y_step
2534# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2535 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2536# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2537 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
2538# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2539 real(wp) :: delta_x, delta_y
2540# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2541 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
2542# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2543 character(len=200) :: errmsg
2544# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2545 real(wp), allocatable :: stored_values(:,:,:)
2546# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2547 real(wp), allocatable :: x_coords(:), y_coords(:)
2548# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2549 logical :: files_loaded = .false.
2550# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2551 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2552# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2553 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
2554# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2555 character(len=20) :: file_num_str !< For storing the file number as a string
2556# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2557 character(len=20) :: zeros_part !< For the trailing zeros part
2558# 303 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2559 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
2560 ! Place any declaration of intermediate variables here
2561# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2562 real(wp) :: eps, eps_mhd, C_mhd
2563# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2564 real(wp) :: r, rmax, gam, umax, p0
2565# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2566 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2567# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2568 real(wp) :: factor
2569# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2570 real(wp) :: r0, alpha, r2
2571# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2572 real(wp) :: sinA, cosA
2573# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2574 real(wp) :: r_sq
2575# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2576
2577# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2578 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
2579# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2580 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
2581# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2582 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
2583# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2584 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
2585# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2586 integer :: igq, jgq
2587# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2588
2589# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2590 ! # 291 - Shear/Thermal Layer Case
2591# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2592 real(wp) :: delta_shear, u_max, u_mean
2593# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2594 real(wp) :: T_wall, T_inf, P_atm, T_loc
2595# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2596 real(wp) :: delta_th, R_mix
2597# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2598 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
2599# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2600 real(wp) :: bottom_blend_u, bottom_blend_T
2601# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2602
2603# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2604 ! # 207
2605# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2606 real(wp) :: sigma, gauss1, gauss2
2607# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2608
2609# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2610 ! # 208
2611# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2612 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2613# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2614
2615# 304 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2616 eps = 1.e-9_wp
2617
2618 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
2619
2620 x_centroid = patch_icpp(patch_id)%x_centroid
2621 y_centroid = patch_icpp(patch_id)%y_centroid
2622 radius = patch_icpp(patch_id)%radius
2623 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2624 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2625
2626 ! Initialize eta=1; modified if smoothing is enabled
2627 eta = 1._wp
2628
2629 ! Assign patch vars if cell is covered and patch has write permission
2630
2631 do j = 0, n
2632 do i = 0, m
2633 if (patch_icpp(patch_id)%smoothen) then
2634 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
2635 eta = tanh(smooth_coeff/min(dx, &
2636 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
2637 end if
2638
2639 if ((f_is_inside_cylinder(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, radius, &
2640 & 0._wp) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
2641 & 0) == smooth_patch_id) then
2642 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
2643
2644
2645 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2646 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2647# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2648 case (200) ! Two-fluid cubic interface
2649# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2650 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2651# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2652 ! Volume Fractions
2653# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2654 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
2655# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2656 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
2657# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2658 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
2659# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2660 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
2661# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2662 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
2663# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2664 end if
2665# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2666 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2667# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2668 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2669# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2670 rmax = 0.2_wp
2671# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2672
2673# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2674 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2675# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2676 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2677# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2678 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2679# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2680
2681# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2682 if (r < rmax) then
2683# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2684 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2685# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2686 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2687# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2688 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2689# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2690 else if (r < 2*rmax) then
2691# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2692 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2693# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2694 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2695# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2696 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
2697# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2698 else
2699# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2700 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2701# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2702 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2703# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2704 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2705# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2706 end if
2707# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2708 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2709# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2710 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2711# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2712 rmax = 0.2_wp
2713# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2714
2715# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2716 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2717# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2718 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2719# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2720 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2721# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2722
2723# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2724 if (r < rmax) then
2725# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2726 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2727# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2728 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2729# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2730 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2731# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2732 else if (r < 2*rmax) then
2733# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2734 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2735# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2736 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2737# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2738 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
2739# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2740 else
2741# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2742 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2743# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2744 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2745# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2746 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2747# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2748 end if
2749# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2750
2751# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2752 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
2753# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2754 case (204) ! Rayleigh-Taylor instability
2755# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2756 rhoh = 3._wp
2757# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2758 rhol = 1._wp
2759# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2760 pref = 1.e5_wp
2761# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2762 pint = pref
2763# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2764 h = 0.7_wp
2765# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2766 lam = 0.2_wp
2767# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2768 wl = 2._wp*pi/lam
2769# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2770 amp = 0.05_wp/wl
2771# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2772
2773# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2774 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2775# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2776
2777# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2778 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2779# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2780
2781# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2782 if (alph < eps) alph = eps
2783# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2784 if (alph > 1._wp - eps) alph = 1._wp - eps
2785# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2786
2787# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2788 if (y_cc(j) > inth) then
2789# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2790 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2791# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2792 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2793# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2794 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2795# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2796 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2797# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2798 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2799# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2800 else
2801# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2802 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2803# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2804 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2805# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2806 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2807# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2808 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2809# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2810 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2811# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2812 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2813# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2814 end if
2815# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2816 case (205) ! 2D lung wave interaction problem
2817# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2818 h = 0.0_wp ! non dim origin y
2819# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2820 lam = 1.0_wp ! non dim lambda
2821# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2822 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
2823# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2824
2825# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2826 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2827# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2828
2829# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2830 if (y_cc(j) > inth) then
2831# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2832 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2833# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2834 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2835# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2836 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2837# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2838 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2839# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2840 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2841# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2842 end if
2843# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2844 case (206) ! 2D lung wave interaction problem - horizontal domain
2845# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2846 h = 0.0_wp ! non dim origin y
2847# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2848 lam = 1.0_wp ! non dim lambda
2849# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2850 amp = patch_icpp(patch_id)%a(2)
2851# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2852
2853# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2854 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2855# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2856
2857# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2858 if (x_cc(i) > intl) then ! this is the liquid
2859# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2860 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2861# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2862 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2863# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2864 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2865# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2866 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2867# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2868 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2869# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2870 end if
2871# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2872 case (207) ! Kelvin Helmholtz Instability
2873# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2874 sigma = 0.05_wp/sqrt(2.0_wp)
2875# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2876 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2877# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2878 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2879# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2880 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
2881# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2882 case (208) ! Richtmeyer Meshkov Instability
2883# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2884 lam = 1.0_wp
2885# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2886 eps = 1.0e-6_wp
2887# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2888 ei = 5.0_wp
2889# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2890 ! Smoothening function to smooth out sharp discontinuity in the interface
2891# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2892 if (x_cc(i) <= 0.7_wp*lam) then
2893# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2894 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2895# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2896 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2897# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2898 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2899# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2900 alpha_sf6 = 1.0_wp - alpha_air
2901# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2902 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
2903# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2904 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
2905# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2906 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
2907# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2908 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
2909# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2910 end if
2911# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2912 case (250) ! MHD Orszag-Tang vortex
2913# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2914 ! 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),
2915# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2916 ! sin(4*pi*x)/sqrt(4*pi), 0)
2917# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2918
2919# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2920 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2921# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2922 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2923# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2924
2925# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2926 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2927# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2928 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2929# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2930 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2931# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2932 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2933# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2934 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
2935# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2936 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
2937# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2938 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2939# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2940 ! Linear interpolation between r=0.08 and r=1.0
2941# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2942 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2943# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2944 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2945# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2946 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2947# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2948 else
2949# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2950 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
2951# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2952 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
2953# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2954 end if
2955# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2956
2957# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2958 ! case 252 is for the 2D MHD Rotor problem
2959# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2960 case (252) ! 2D MHD Rotor Problem
2961# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2962 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
2963# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2964 !
2965# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2966 ! 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
2967# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2968 ! velocity w=20, giving v_tan=2 at r=0.1
2969# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2970
2971# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2972 ! Calculate distance squared from the center
2973# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2974 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2975# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2976
2977# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2978 ! inner radius of 0.1
2979# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2980 if (r_sq <= 0.1**2) then
2981# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2982 ! -- Inside the rotor -- Set density uniformly to 10
2983# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2984 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
2985# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2986
2987# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2988 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
2989# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2990 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2991# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2992 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2993# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2994
2995# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2996 ! taper width of 0.015
2997# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2998 else if (r_sq <= 0.115**2) then
2999# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3000 ! linearly smooth the function between r = 0.1 and 0.115
3001# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3002 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3003# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3004
3005# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3006 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3007# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3008 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
3009# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3010 end if
3011# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3012 case (253) ! MHD Smooth Magnetic Vortex
3013# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3014 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
3015# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3016 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
3017# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3018
3019# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3020 ! velocity
3021# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3022 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3023# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3024 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
3025# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3026
3027# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3028 ! magnetic field
3029# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3030 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3031# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3032 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3033# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3034
3035# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3036 ! pressure
3037# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3038 q_prim_vf(eqn_idx%E)%sf(i, j, &
3039# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3040 & 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)
3041# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3042 case (260) ! Gaussian Divergence Pulse
3043# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3044 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
3045# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3046 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
3047# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3048 ! initialized to zero everywhere.
3049# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3050
3051# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3052 eps_mhd = patch_icpp(patch_id)%a(2)
3053# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3054 sigma = patch_icpp(patch_id)%a(3)
3055# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3056 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3057# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3058
3059# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3060 ! B-field
3061# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3062 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3063# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3064 case (261) ! Blob
3065# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3066 r0 = 1._wp/sqrt(8._wp)
3067# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3068 r2 = x_cc(i)**2 + y_cc(j)**2
3069# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3070 r = sqrt(r2)
3071# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3072 alpha = r/r0
3073# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3074 if (alpha < 1) then
3075# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3076 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
3077# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3078 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
3079# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3080 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
3081# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3082 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
3083# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3084 end if
3085# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3086 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
3087# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3088 ! rotate by \alpha = atan(2)
3089# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3090 alpha = atan(2._wp)
3091# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3092 cosa = cos(alpha)
3093# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3094 sina = sin(alpha)
3095# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3096 ! projection along shock normal
3097# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3098 r = x_cc(i)*cosa + y_cc(j)*sina
3099# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3100
3101# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3102 if (r <= 0.5_wp) then
3103# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3104 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
3105# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3106 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3107# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3108 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
3109# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3110 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
3111# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3112 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
3113# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3114 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
3115# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3116 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
3117# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3118 else
3119# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3120 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
3121# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3122 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3123# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3124 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
3125# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3126 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
3127# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3128 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
3129# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3130 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
3131# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3132 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
3133# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3134 end if
3135# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3136 ! v^z and B^z remain zero by default
3137# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3138 case (270) ! 2D extrusion of 1D profile from external data
3139# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3140 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
3141# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3142 if (.not. files_loaded) then
3143# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3144 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3145# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3146 do f = 1, max_files
3147# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3148 write (file_num_str, '(I0)') f
3149# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3150 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
3151# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3152 end do
3153# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3154
3155# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3156 ! Common file reading setup
3157# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3158 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3159# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3160 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3161# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3162
3163# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3164 select case (num_dims)
3165# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3166 case (1, 2) ! 1D and 2D cases are similar
3167# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3168 ! Count lines
3169# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3170 line_count = 0
3171# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3172 do
3173# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3174 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3175# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3176 if (ios2 /= 0) exit
3177# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3178 line_count = line_count + 1
3179# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3180 end do
3181# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3182 close (unit2)
3183# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3184
3185# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3186 xrows = line_count
3187# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3188 yrows = 1
3189# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3190 index_x = 0
3191# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3192 if (num_dims == 2) index_x = i
3193# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3194#ifdef MFC_DEBUG
3195# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3196 block
3197# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3198 use iso_fortran_env, only: output_unit
3199# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3200
3201# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3202 print *, 'm_icpp_patches.fpp:334: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3203# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3204
3205# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3206 call flush (output_unit)
3207# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3208 end block
3209# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3210#endif
3211# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3212 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3213# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3214
3215# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3216
3217# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3218
3219# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3220#if defined(MFC_OpenACC)
3221# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3222!$acc enter data create(x_coords, stored_values)
3223# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3224#elif defined(MFC_OpenMP)
3225# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3226!$omp target enter data map(always,alloc:x_coords, stored_values)
3227# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3228#endif
3229# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3230
3231# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3232 ! Read data from all files
3233# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3234 do f = 1, max_files
3235# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3236 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3237# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3238 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3239# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3240
3241# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3242 do iter = 1, xrows
3243# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3244 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3245# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3246 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3247# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3248 end do
3249# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3250 close (unit)
3251# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3252 end do
3253# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3254
3255# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3256 ! Calculate offsets
3257# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3258 domain_xstart = x_coords(1)
3259# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3260 x_step = x_cc(1) - x_cc(0)
3261# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3262 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)
3263# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3264 global_offset_x = nint(abs(delta_x)/x_step)
3265# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3266 case (3) ! 3D case - determine grid structure
3267# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3268 ! Find yRows by counting rows with same x
3269# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3270 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3271# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3272 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3273# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3274
3275# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3276 yrows = 1
3277# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3278 do
3279# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3280 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3281# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3282 if (ios2 /= 0) exit
3283# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3284 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3285# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3286 yrows = yrows + 1
3287# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3288 else
3289# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3290 exit
3291# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3292 end if
3293# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3294 end do
3295# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3296 close (unit2)
3297# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3298
3299# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3300 ! Count total rows
3301# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3302 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3303# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3304 nrows = 0
3305# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3306 do
3307# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3308 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3309# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3310 if (ios2 /= 0) exit
3311# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3312 nrows = nrows + 1
3313# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3314 end do
3315# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3316 close (unit2)
3317# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3318
3319# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3320 xrows = nrows/yrows
3321# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3322#ifdef MFC_DEBUG
3323# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3324 block
3325# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3326 use iso_fortran_env, only: output_unit
3327# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3328
3329# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3330 print *, 'm_icpp_patches.fpp:334: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3331# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3332
3333# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3334 call flush (output_unit)
3335# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3336 end block
3337# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3338#endif
3339# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3340 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3341# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3342
3343# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3344
3345# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3346
3347# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3348
3349# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3350#if defined(MFC_OpenACC)
3351# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3352!$acc enter data create(x_coords, y_coords, stored_values)
3353# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3354#elif defined(MFC_OpenMP)
3355# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3356!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3357# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3358#endif
3359# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3360 index_x = i
3361# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3362 index_y = j
3363# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3364
3365# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3366 ! Read all files
3367# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3368 do f = 1, max_files
3369# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3370 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3371# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3372 if (ios /= 0) then
3373# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3374 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3375# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3376 cycle
3377# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3378 end if
3379# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3380
3381# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3382 iter = 0
3383# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3384 do iix = 1, xrows
3385# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3386 do iiy = 1, yrows
3387# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3388 iter = iter + 1
3389# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3390 if (f == 1) then
3391# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3392 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3393# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3394 else
3395# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3396 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3397# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3398 end if
3399# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3400 if (ios /= 0) call s_mpi_abort("Error reading data")
3401# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3402 end do
3403# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3404 end do
3405# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3406 close (unit)
3407# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3408 end do
3409# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3410
3411# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3412 ! Calculate offsets
3413# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3414 x_step = x_cc(1) - x_cc(0)
3415# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3416 y_step = y_cc(1) - y_cc(0)
3417# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3418 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3419# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3420 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3421# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3422 global_offset_x = nint(abs(delta_x)/x_step)
3423# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3424 global_offset_y = nint(abs(delta_y)/y_step)
3425# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3426 end select
3427# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3428
3429# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3430 files_loaded = .true.
3431# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3432 end if
3433# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3434
3435# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3436 ! Data assignment
3437# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3438 select case (num_dims)
3439# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3440 case (1)
3441# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3442 idx = i + 1 + global_offset_x
3443# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3444 do f = 1, sys_size
3445# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3446 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3447# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3448 end do
3449# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3450 case (2)
3451# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3452 idx = i + 1 + global_offset_x - index_x
3453# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3454 do f = 1, sys_size - 1
3455# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3456 jump = merge(1, 0, f >= eqn_idx%mom%end)
3457# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3458 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3459# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3460 end do
3461# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3462 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3463# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3464 case (3)
3465# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3466 idx = i + 1 + global_offset_x - index_x
3467# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3468 idy = j + 1 + global_offset_y - index_y
3469# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3470 do f = 1, sys_size - 1
3471# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3472 jump = merge(1, 0, f >= eqn_idx%mom%end)
3473# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3474 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3475# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3476 end do
3477# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3478 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3479# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3480 end select
3481# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3482 case (280) ! Isentropic vortex
3483# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3484 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3485# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3486 ! geometry 2
3487# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3488 if (patch_id == 1) then
3489# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3490 q_prim_vf(eqn_idx%E)%sf(i, j, &
3491# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3492 & 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) &
3493# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3494 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3495# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3496 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3497# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3498 & 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) &
3499# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3500 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3501# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3502 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3503# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3504 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
3505# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3506 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3507# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3508 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3509# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3510 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
3511# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3512 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3513# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3514 end if
3515# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3516 case (281) ! Acoustic pulse
3517# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3518 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3519# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3520 ! geometry 2
3521# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3522 if (patch_id == 2) then
3523# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3524 q_prim_vf(eqn_idx%E)%sf(i, j, &
3525# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3526 & 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))
3527# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3528 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3529# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3530 & 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))
3531# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3532 end if
3533# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3534 case (282) ! Zero-circulation vortex
3535# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3536 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
3537# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3538 ! geometry 2
3539# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3540 if (patch_id == 2) then
3541# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3542 q_prim_vf(eqn_idx%E)%sf(i, j, &
3543# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3544 & 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))
3545# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3546 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3547# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3548 & 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))
3549# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3550 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3551# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3552 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3553# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3554 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3555# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3556 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3557# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3558 end if
3559# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3560 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
3561# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3562 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
3563# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3564 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
3565# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3566 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
3567# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3568 ! patch_icpp(patch_id)%epsilon; defaults to 5.
3569# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3570 if (patch_id == 1) then
3571# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3572 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
3573# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3574 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
3575# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3576 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
3577# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3578 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
3579# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3580 do igq = 1, 3
3581# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3582 do jgq = 1, 3
3583# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3584 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
3585# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3586 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
3587# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3588 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
3589# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3590 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
3591# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3592 wq = gauss_w(igq)*gauss_w(jgq)
3593# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3594 rhoq = t_facq**1.4_wp
3595# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3596 pq = t_facq**2.4_wp
3597# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3598 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3599# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3600 & - r2q)
3601# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3602 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3603# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3604 & - r2q)
3605# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3606 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
3607# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3608 rho_avg = rho_avg + wq*rhoq
3609# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3610 rhou_avg = rhou_avg + wq*(rhoq*uq)
3611# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3612 rhov_avg = rhov_avg + wq*(rhoq*vq)
3613# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3614 e_avg = e_avg + wq*eq
3615# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3616 end do
3617# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3618 end do
3619# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3620 rho_avg = rho_avg*0.25_wp
3621# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3622 rhou_avg = rhou_avg*0.25_wp
3623# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3624 rhov_avg = rhov_avg*0.25_wp
3625# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3626 e_avg = e_avg*0.25_wp
3627# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3628 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
3629# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3630 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
3631# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3632 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
3633# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3634 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
3635# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3636 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
3637# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3638 end if
3639# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3640 case (291) ! Isothermal Flat Plate
3641# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3642 t_inf = 1125.0_wp
3643# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3644 t_wall = 600.0_wp
3645# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3646 p_atm = 101325.0_wp
3647# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3648
3649# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3650 ! Boundary/Shear Layer thicknesses
3651# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3652 delta_th = 0.0003_wp ! Thermal BL thickness
3653# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3654 delta_shear = 8e-3_wp ! Velocity BL thickness
3655# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3656
3657# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3658 u_max = 50.0_wp ! Freestream Velocity (m/s)
3659# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3660
3661# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3662 mw_n2 = 28.0134e-3_wp
3663# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3664 mw_o2 = 31.999e-3_wp
3665# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3666 y_n2 = 0.767_wp
3667# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3668 y_o2 = 0.233_wp
3669# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3670 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
3671# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3672 bottom_blend_u = tanh(y_cc(j)/delta_shear)
3673# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3674 bottom_blend_t = tanh(y_cc(j)/delta_th)
3675# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3676 u_mean = u_max*bottom_blend_u
3677# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3678 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
3679# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3680 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
3681# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3682 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
3683# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3684 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3685# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3686 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
3687# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3688 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
3689# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3690 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
3691# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3692 case default
3693# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3694 if (proc_rank == 0) then
3695# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3696 call s_int_to_str(patch_id, istr)
3697# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3698 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
3699# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3700 end if
3701# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3702 end select
3703 end if
3704 end if
3705 end do
3706 end do
3707 if (allocated(stored_values)) then
3708# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3709#ifdef MFC_DEBUG
3710# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3711 block
3712# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3713 use iso_fortran_env, only: output_unit
3714# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3715
3716# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3717 print *, 'm_icpp_patches.fpp:339: ', '@:DEALLOCATE(stored_values)'
3718# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3719
3720# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3721 call flush (output_unit)
3722# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723 end block
3724# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725#endif
3726# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727
3728# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729#if defined(MFC_OpenACC)
3730# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731!$acc exit data delete(stored_values)
3732# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733#elif defined(MFC_OpenMP)
3734# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735!$omp target exit data map(release:stored_values)
3736# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737#endif
3738# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739 deallocate (stored_values)
3740# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741#ifdef MFC_DEBUG
3742# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 block
3744# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745 use iso_fortran_env, only: output_unit
3746# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747
3748# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3749 print *, 'm_icpp_patches.fpp:339: ', '@:DEALLOCATE(x_coords)'
3750# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3751
3752# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3753 call flush (output_unit)
3754# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3755 end block
3756# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3757#endif
3758# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3759
3760# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3761#if defined(MFC_OpenACC)
3762# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3763!$acc exit data delete(x_coords)
3764# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3765#elif defined(MFC_OpenMP)
3766# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3767!$omp target exit data map(release:x_coords)
3768# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3769#endif
3770# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3771 deallocate (x_coords)
3772# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3773 end if
3774# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3775
3776# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3777 if (allocated(y_coords)) then
3778# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3779#ifdef MFC_DEBUG
3780# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3781 block
3782# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3783 use iso_fortran_env, only: output_unit
3784# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3785
3786# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787 print *, 'm_icpp_patches.fpp:339: ', '@:DEALLOCATE(y_coords)'
3788# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789
3790# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791 call flush (output_unit)
3792# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793 end block
3794# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795#endif
3796# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797
3798# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799#if defined(MFC_OpenACC)
3800# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801!$acc exit data delete(y_coords)
3802# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3803#elif defined(MFC_OpenMP)
3804# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3805!$omp target exit data map(release:y_coords)
3806# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3807#endif
3808# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3809 deallocate (y_coords)
3810# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3811 end if
3812
3813 end subroutine s_icpp_circle
3814
3815 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
3816 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3817
3818 ! Patch identifier
3819 integer, intent(in) :: patch_id
3820
3821#ifdef MFC_MIXED_PRECISION
3822 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3823#else
3824 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3825#endif
3826 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3827
3828 ! Generic loop iterators
3829 integer :: i, j, k
3830 real(wp) :: radius, myr, thickness
3831
3832 integer :: xRows, yRows, nRows, iix, iiy, max_files
3833# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3834 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3835# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3836 real(wp) :: x_len, x_step, y_len, y_step
3837# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3838 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3839# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3840 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
3841# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3842 real(wp) :: delta_x, delta_y
3843# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3844 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
3845# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3846 character(len=200) :: errmsg
3847# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3848 real(wp), allocatable :: stored_values(:,:,:)
3849# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3850 real(wp), allocatable :: x_coords(:), y_coords(:)
3851# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3852 logical :: files_loaded = .false.
3853# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3854 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3855# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3856 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
3857# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3858 character(len=20) :: file_num_str !< For storing the file number as a string
3859# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3860 character(len=20) :: zeros_part !< For the trailing zeros part
3861# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3862 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
3863 ! Place any declaration of intermediate variables here
3864# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865 real(wp) :: eps, eps_mhd, C_mhd
3866# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 real(wp) :: r, rmax, gam, umax, p0
3868# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3870# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 real(wp) :: factor
3872# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 real(wp) :: r0, alpha, r2
3874# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875 real(wp) :: sinA, cosA
3876# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 real(wp) :: r_sq
3878# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879
3880# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
3882# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
3884# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
3886# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
3888# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 integer :: igq, jgq
3890# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891
3892# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893 ! # 291 - Shear/Thermal Layer Case
3894# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895 real(wp) :: delta_shear, u_max, u_mean
3896# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897 real(wp) :: T_wall, T_inf, P_atm, T_loc
3898# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899 real(wp) :: delta_th, R_mix
3900# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
3902# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 real(wp) :: bottom_blend_u, bottom_blend_T
3904# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905
3906# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907 ! # 207
3908# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909 real(wp) :: sigma, gauss1, gauss2
3910# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3911
3912# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3913 ! # 208
3914# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3915 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3916# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3917
3918# 361 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3919 eps = 1.e-9_wp
3920
3921 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
3922 x_centroid = patch_icpp(patch_id)%x_centroid
3923 y_centroid = patch_icpp(patch_id)%y_centroid
3924 radius = patch_icpp(patch_id)%radius
3925 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3926 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3927 thickness = patch_icpp(patch_id)%epsilon
3928
3929 ! Initialize eta=1; modified if smoothing is enabled
3930 eta = 1._wp
3931
3932 ! Assign patch vars if cell is covered and patch has write permission
3933 do j = 0, n
3934 do i = 0, m
3935 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
3936
3937 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
3938 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
3939 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
3940
3941
3942 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3943 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3944# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 case (200) ! Two-fluid cubic interface
3946# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3948# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 ! Volume Fractions
3950# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
3952# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
3954# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
3956# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
3958# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
3960# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 end if
3962# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3964# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3966# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967 rmax = 0.2_wp
3968# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969
3970# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3972# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3974# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3975 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3976# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3977
3978# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3979 if (r < rmax) then
3980# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3981 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3982# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3984# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3986# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 else if (r < 2*rmax) then
3988# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3990# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3992# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
3994# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 else
3996# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
3998# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4000# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
4002# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003 end if
4004# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
4006# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4008# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009 rmax = 0.2_wp
4010# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011
4012# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4014# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4016# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4018# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019
4020# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021 if (r < rmax) then
4022# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4024# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4026# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4028# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 else if (r < 2*rmax) then
4030# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4032# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4034# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
4036# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037 else
4038# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4040# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4042# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
4044# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 end if
4046# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047
4048# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
4050# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 case (204) ! Rayleigh-Taylor instability
4052# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053 rhoh = 3._wp
4054# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 rhol = 1._wp
4056# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 pref = 1.e5_wp
4058# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059 pint = pref
4060# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 h = 0.7_wp
4062# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063 lam = 0.2_wp
4064# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065 wl = 2._wp*pi/lam
4066# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067 amp = 0.05_wp/wl
4068# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069
4070# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
4072# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073
4074# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4076# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077
4078# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079 if (alph < eps) alph = eps
4080# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081 if (alph > 1._wp - eps) alph = 1._wp - eps
4082# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083
4084# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085 if (y_cc(j) > inth) then
4086# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4088# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4090# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4092# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4094# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4096# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 else
4098# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4100# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4102# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4104# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4106# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4108# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
4110# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111 end if
4112# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113 case (205) ! 2D lung wave interaction problem
4114# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115 h = 0.0_wp ! non dim origin y
4116# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117 lam = 1.0_wp ! non dim lambda
4118# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
4120# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121
4122# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
4124# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125
4126# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127 if (y_cc(j) > inth) then
4128# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4130# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4132# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4133 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4134# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4135 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4136# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4137 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4138# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4139 end if
4140# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4141 case (206) ! 2D lung wave interaction problem - horizontal domain
4142# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4143 h = 0.0_wp ! non dim origin y
4144# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4145 lam = 1.0_wp ! non dim lambda
4146# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4147 amp = patch_icpp(patch_id)%a(2)
4148# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4149
4150# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4151 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4152# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153
4154# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 if (x_cc(i) > intl) then ! this is the liquid
4156# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4158# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4160# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4162# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4164# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4166# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 end if
4168# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 case (207) ! Kelvin Helmholtz Instability
4170# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 sigma = 0.05_wp/sqrt(2.0_wp)
4172# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4174# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4176# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
4178# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179 case (208) ! Richtmeyer Meshkov Instability
4180# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 lam = 1.0_wp
4182# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183 eps = 1.0e-6_wp
4184# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 ei = 5.0_wp
4186# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187 ! Smoothening function to smooth out sharp discontinuity in the interface
4188# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 if (x_cc(i) <= 0.7_wp*lam) then
4190# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4192# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
4194# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4196# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 alpha_sf6 = 1.0_wp - alpha_air
4198# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
4200# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
4202# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
4204# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
4206# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207 end if
4208# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209 case (250) ! MHD Orszag-Tang vortex
4210# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211 ! 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),
4212# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213 ! sin(4*pi*x)/sqrt(4*pi), 0)
4214# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215
4216# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4218# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4220# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221
4222# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4224# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4226# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4228# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4230# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4231 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
4232# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4233 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
4234# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4236# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237 ! Linear interpolation between r=0.08 and r=1.0
4238# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4240# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4242# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4244# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245 else
4246# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
4248# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
4250# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251 end if
4252# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253
4254# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255 ! case 252 is for the 2D MHD Rotor problem
4256# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257 case (252) ! 2D MHD Rotor Problem
4258# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
4260# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261 !
4262# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263 ! 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
4264# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265 ! velocity w=20, giving v_tan=2 at r=0.1
4266# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4267
4268# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269 ! Calculate distance squared from the center
4270# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4272# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273
4274# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275 ! inner radius of 0.1
4276# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277 if (r_sq <= 0.1**2) then
4278# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279 ! -- Inside the rotor -- Set density uniformly to 10
4280# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
4282# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283
4284# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
4286# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4288# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4290# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291
4292# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293 ! taper width of 0.015
4294# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 else if (r_sq <= 0.115**2) then
4296# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297 ! linearly smooth the function between r = 0.1 and 0.115
4298# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4300# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301
4302# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4304# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4306# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307 end if
4308# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 case (253) ! MHD Smooth Magnetic Vortex
4310# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
4312# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4314# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315
4316# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317 ! velocity
4318# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4320# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4322# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323
4324# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325 ! magnetic field
4326# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4328# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4330# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331
4332# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333 ! pressure
4334# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335 q_prim_vf(eqn_idx%E)%sf(i, j, &
4336# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337 & 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)
4338# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339 case (260) ! Gaussian Divergence Pulse
4340# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4341 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
4342# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4343 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
4344# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4345 ! initialized to zero everywhere.
4346# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4347
4348# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4349 eps_mhd = patch_icpp(patch_id)%a(2)
4350# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4351 sigma = patch_icpp(patch_id)%a(3)
4352# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4353 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4354# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4355
4356# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4357 ! B-field
4358# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4359 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4360# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4361 case (261) ! Blob
4362# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4363 r0 = 1._wp/sqrt(8._wp)
4364# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4365 r2 = x_cc(i)**2 + y_cc(j)**2
4366# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4367 r = sqrt(r2)
4368# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4369 alpha = r/r0
4370# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4371 if (alpha < 1) then
4372# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4373 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
4374# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4375 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
4376# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4377 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4378# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4379 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
4380# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4381 end if
4382# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4383 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
4384# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4385 ! rotate by \alpha = atan(2)
4386# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4387 alpha = atan(2._wp)
4388# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4389 cosa = cos(alpha)
4390# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4391 sina = sin(alpha)
4392# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4393 ! projection along shock normal
4394# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4395 r = x_cc(i)*cosa + y_cc(j)*sina
4396# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4397
4398# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4399 if (r <= 0.5_wp) then
4400# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4401 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4402# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4403 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4404# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4405 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
4406# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4407 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
4408# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4409 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
4410# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4411 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4412# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4413 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4414# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4415 else
4416# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4417 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4418# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4419 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4420# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4421 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
4422# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4423 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
4424# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4425 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
4426# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4427 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
4428# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4429 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
4430# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4431 end if
4432# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4433 ! v^z and B^z remain zero by default
4434# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4435 case (270) ! 2D extrusion of 1D profile from external data
4436# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4437 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4438# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4439 if (.not. files_loaded) then
4440# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4441 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4442# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4443 do f = 1, max_files
4444# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4445 write (file_num_str, '(I0)') f
4446# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4447 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
4448# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4449 end do
4450# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4451
4452# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4453 ! Common file reading setup
4454# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4455 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4456# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4457 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
4458# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4459
4460# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4461 select case (num_dims)
4462# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4463 case (1, 2) ! 1D and 2D cases are similar
4464# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4465 ! Count lines
4466# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4467 line_count = 0
4468# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4469 do
4470# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4471 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4472# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4473 if (ios2 /= 0) exit
4474# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4475 line_count = line_count + 1
4476# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4477 end do
4478# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4479 close (unit2)
4480# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4481
4482# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4483 xrows = line_count
4484# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4485 yrows = 1
4486# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4487 index_x = 0
4488# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4489 if (num_dims == 2) index_x = i
4490# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4491#ifdef MFC_DEBUG
4492# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4493 block
4494# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4495 use iso_fortran_env, only: output_unit
4496# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4497
4498# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4499 print *, 'm_icpp_patches.fpp:385: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4500# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4501
4502# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4503 call flush (output_unit)
4504# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4505 end block
4506# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4507#endif
4508# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4509 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4510# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4511
4512# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4513
4514# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4515
4516# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4517#if defined(MFC_OpenACC)
4518# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4519!$acc enter data create(x_coords, stored_values)
4520# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4521#elif defined(MFC_OpenMP)
4522# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4523!$omp target enter data map(always,alloc:x_coords, stored_values)
4524# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4525#endif
4526# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4527
4528# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4529 ! Read data from all files
4530# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4531 do f = 1, max_files
4532# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4533 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4534# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4535 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4536# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4537
4538# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4539 do iter = 1, xrows
4540# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4541 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4542# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4543 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
4544# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4545 end do
4546# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4547 close (unit)
4548# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4549 end do
4550# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4551
4552# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4553 ! Calculate offsets
4554# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4555 domain_xstart = x_coords(1)
4556# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4557 x_step = x_cc(1) - x_cc(0)
4558# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4559 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)
4560# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4561 global_offset_x = nint(abs(delta_x)/x_step)
4562# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4563 case (3) ! 3D case - determine grid structure
4564# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4565 ! Find yRows by counting rows with same x
4566# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4567 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4568# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4569 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4570# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4571
4572# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4573 yrows = 1
4574# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4575 do
4576# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4577 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4578# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4579 if (ios2 /= 0) exit
4580# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4581 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
4582# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4583 yrows = yrows + 1
4584# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4585 else
4586# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4587 exit
4588# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4589 end if
4590# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4591 end do
4592# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4593 close (unit2)
4594# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4595
4596# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4597 ! Count total rows
4598# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4599 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4600# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4601 nrows = 0
4602# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4603 do
4604# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4605 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4606# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4607 if (ios2 /= 0) exit
4608# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4609 nrows = nrows + 1
4610# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4611 end do
4612# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4613 close (unit2)
4614# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4615
4616# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4617 xrows = nrows/yrows
4618# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4619#ifdef MFC_DEBUG
4620# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4621 block
4622# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4623 use iso_fortran_env, only: output_unit
4624# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4625
4626# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4627 print *, 'm_icpp_patches.fpp:385: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4628# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4629
4630# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4631 call flush (output_unit)
4632# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4633 end block
4634# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4635#endif
4636# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4637 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4638# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4639
4640# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4641
4642# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4643
4644# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4645
4646# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4647#if defined(MFC_OpenACC)
4648# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4649!$acc enter data create(x_coords, y_coords, stored_values)
4650# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4651#elif defined(MFC_OpenMP)
4652# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4653!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4654# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4655#endif
4656# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4657 index_x = i
4658# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4659 index_y = j
4660# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4661
4662# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4663 ! Read all files
4664# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4665 do f = 1, max_files
4666# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4667 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4668# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4669 if (ios /= 0) then
4670# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4671 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4672# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4673 cycle
4674# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4675 end if
4676# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4677
4678# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4679 iter = 0
4680# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4681 do iix = 1, xrows
4682# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4683 do iiy = 1, yrows
4684# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4685 iter = iter + 1
4686# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4687 if (f == 1) then
4688# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4689 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4690# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4691 else
4692# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4693 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4694# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4695 end if
4696# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4697 if (ios /= 0) call s_mpi_abort("Error reading data")
4698# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4699 end do
4700# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4701 end do
4702# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4703 close (unit)
4704# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4705 end do
4706# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4707
4708# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4709 ! Calculate offsets
4710# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4711 x_step = x_cc(1) - x_cc(0)
4712# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4713 y_step = y_cc(1) - y_cc(0)
4714# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4715 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4716# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4717 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4718# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4719 global_offset_x = nint(abs(delta_x)/x_step)
4720# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4721 global_offset_y = nint(abs(delta_y)/y_step)
4722# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4723 end select
4724# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4725
4726# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4727 files_loaded = .true.
4728# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4729 end if
4730# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4731
4732# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4733 ! Data assignment
4734# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4735 select case (num_dims)
4736# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4737 case (1)
4738# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4739 idx = i + 1 + global_offset_x
4740# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4741 do f = 1, sys_size
4742# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4743 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4744# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4745 end do
4746# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4747 case (2)
4748# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4749 idx = i + 1 + global_offset_x - index_x
4750# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4751 do f = 1, sys_size - 1
4752# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4753 jump = merge(1, 0, f >= eqn_idx%mom%end)
4754# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4755 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4756# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4757 end do
4758# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4759 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4760# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4761 case (3)
4762# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4763 idx = i + 1 + global_offset_x - index_x
4764# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4765 idy = j + 1 + global_offset_y - index_y
4766# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4767 do f = 1, sys_size - 1
4768# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4769 jump = merge(1, 0, f >= eqn_idx%mom%end)
4770# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4771 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4772# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4773 end do
4774# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4775 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
4776# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4777 end select
4778# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4779 case (280) ! Isentropic vortex
4780# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4781 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
4782# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4783 ! geometry 2
4784# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4785 if (patch_id == 1) then
4786# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4787 q_prim_vf(eqn_idx%E)%sf(i, j, &
4788# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4789 & 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) &
4790# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4791 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
4792# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4793 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4794# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4795 & 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) &
4796# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4797 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
4798# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4799 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4800# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4801 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
4802# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4803 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4804# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4805 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4806# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4807 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
4808# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4809 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4810# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4811 end if
4812# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4813 case (281) ! Acoustic pulse
4814# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4815 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
4816# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4817 ! geometry 2
4818# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4819 if (patch_id == 2) then
4820# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4821 q_prim_vf(eqn_idx%E)%sf(i, j, &
4822# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4823 & 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))
4824# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4825 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4826# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4827 & 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))
4828# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4829 end if
4830# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4831 case (282) ! Zero-circulation vortex
4832# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4833 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
4834# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4835 ! geometry 2
4836# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4837 if (patch_id == 2) then
4838# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4839 q_prim_vf(eqn_idx%E)%sf(i, j, &
4840# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4841 & 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))
4842# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4843 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4844# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4845 & 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))
4846# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4847 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4848# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4849 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4850# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4851 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4852# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4853 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4854# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4855 end if
4856# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4857 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
4858# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4859 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
4860# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4861 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
4862# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4863 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
4864# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4865 ! patch_icpp(patch_id)%epsilon; defaults to 5.
4866# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4867 if (patch_id == 1) then
4868# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4869 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
4870# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4871 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
4872# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4873 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
4874# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4875 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
4876# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4877 do igq = 1, 3
4878# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4879 do jgq = 1, 3
4880# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4881 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
4882# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4883 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
4884# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4885 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
4886# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4887 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
4888# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4889 wq = gauss_w(igq)*gauss_w(jgq)
4890# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4891 rhoq = t_facq**1.4_wp
4892# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4893 pq = t_facq**2.4_wp
4894# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4895 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4896# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4897 & - r2q)
4898# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4899 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4900# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4901 & - r2q)
4902# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4903 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
4904# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4905 rho_avg = rho_avg + wq*rhoq
4906# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4907 rhou_avg = rhou_avg + wq*(rhoq*uq)
4908# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4909 rhov_avg = rhov_avg + wq*(rhoq*vq)
4910# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4911 e_avg = e_avg + wq*eq
4912# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4913 end do
4914# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4915 end do
4916# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4917 rho_avg = rho_avg*0.25_wp
4918# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4919 rhou_avg = rhou_avg*0.25_wp
4920# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4921 rhov_avg = rhov_avg*0.25_wp
4922# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4923 e_avg = e_avg*0.25_wp
4924# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4925 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
4926# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4927 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
4928# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4929 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
4930# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4931 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
4932# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4933 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
4934# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4935 end if
4936# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4937 case (291) ! Isothermal Flat Plate
4938# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4939 t_inf = 1125.0_wp
4940# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4941 t_wall = 600.0_wp
4942# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4943 p_atm = 101325.0_wp
4944# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4945
4946# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4947 ! Boundary/Shear Layer thicknesses
4948# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4949 delta_th = 0.0003_wp ! Thermal BL thickness
4950# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4951 delta_shear = 8e-3_wp ! Velocity BL thickness
4952# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4953
4954# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4955 u_max = 50.0_wp ! Freestream Velocity (m/s)
4956# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4957
4958# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4959 mw_n2 = 28.0134e-3_wp
4960# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4961 mw_o2 = 31.999e-3_wp
4962# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4963 y_n2 = 0.767_wp
4964# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4965 y_o2 = 0.233_wp
4966# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4967 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
4968# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4969 bottom_blend_u = tanh(y_cc(j)/delta_shear)
4970# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4971 bottom_blend_t = tanh(y_cc(j)/delta_th)
4972# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4973 u_mean = u_max*bottom_blend_u
4974# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4975 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
4976# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4977 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
4978# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4979 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
4980# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4981 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4982# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4983 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
4984# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4985 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
4986# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4987 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
4988# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4989 case default
4990# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4991 if (proc_rank == 0) then
4992# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4993 call s_int_to_str(patch_id, istr)
4994# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4995 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
4996# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4997 end if
4998# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4999 end select
5000 end if
5001
5002 ! Updating the patch identities bookkeeping variable
5003 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
5004
5005 q_prim_vf(eqn_idx%alf)%sf(i, j, &
5006 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5007 end if
5008 end do
5009 end do
5010 if (allocated(stored_values)) then
5011# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012#ifdef MFC_DEBUG
5013# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 block
5015# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 use iso_fortran_env, only: output_unit
5017# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018
5019# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020 print *, 'm_icpp_patches.fpp:396: ', '@:DEALLOCATE(stored_values)'
5021# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022
5023# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024 call flush (output_unit)
5025# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026 end block
5027# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028#endif
5029# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030
5031# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032#if defined(MFC_OpenACC)
5033# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034!$acc exit data delete(stored_values)
5035# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036#elif defined(MFC_OpenMP)
5037# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038!$omp target exit data map(release:stored_values)
5039# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040#endif
5041# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042 deallocate (stored_values)
5043# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044#ifdef MFC_DEBUG
5045# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 block
5047# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048 use iso_fortran_env, only: output_unit
5049# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050
5051# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052 print *, 'm_icpp_patches.fpp:396: ', '@:DEALLOCATE(x_coords)'
5053# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054
5055# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056 call flush (output_unit)
5057# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058 end block
5059# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060#endif
5061# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062
5063# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064#if defined(MFC_OpenACC)
5065# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066!$acc exit data delete(x_coords)
5067# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068#elif defined(MFC_OpenMP)
5069# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5070!$omp target exit data map(release:x_coords)
5071# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5072#endif
5073# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5074 deallocate (x_coords)
5075# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5076 end if
5077# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5078
5079# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5080 if (allocated(y_coords)) then
5081# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5082#ifdef MFC_DEBUG
5083# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5084 block
5085# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5086 use iso_fortran_env, only: output_unit
5087# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5088
5089# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5090 print *, 'm_icpp_patches.fpp:396: ', '@:DEALLOCATE(y_coords)'
5091# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5092
5093# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5094 call flush (output_unit)
5095# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5096 end block
5097# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5098#endif
5099# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5100
5101# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5102#if defined(MFC_OpenACC)
5103# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5104!$acc exit data delete(y_coords)
5105# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5106#elif defined(MFC_OpenMP)
5107# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5108!$omp target exit data map(release:y_coords)
5109# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5110#endif
5111# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5112 deallocate (y_coords)
5113# 396 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5114 end if
5115
5116 end subroutine s_icpp_varcircle
5117
5118 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
5119 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
5120
5121 ! Patch identifier
5122 integer, intent(in) :: patch_id
5123
5124#ifdef MFC_MIXED_PRECISION
5125 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5126#else
5127 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5128#endif
5129 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5130
5131 ! Generic loop iterators
5132 integer :: i, j, k
5133 real(wp) :: radius, myr, thickness
5134
5135 integer :: xRows, yRows, nRows, iix, iiy, max_files
5136# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5137 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5138# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5139 real(wp) :: x_len, x_step, y_len, y_step
5140# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5141 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5142# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5143 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
5144# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5145 real(wp) :: delta_x, delta_y
5146# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5147 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
5148# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5149 character(len=200) :: errmsg
5150# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5151 real(wp), allocatable :: stored_values(:,:,:)
5152# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5153 real(wp), allocatable :: x_coords(:), y_coords(:)
5154# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5155 logical :: files_loaded = .false.
5156# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5157 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5158# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5159 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
5160# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5161 character(len=20) :: file_num_str !< For storing the file number as a string
5162# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5163 character(len=20) :: zeros_part !< For the trailing zeros part
5164# 417 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5165 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
5166 ! Place any declaration of intermediate variables here
5167# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5168 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
5169# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5170 real(wp) :: eps
5171# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5172
5173# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5174 ! IGR Jets Arrays to stor position and radii of jets from input file
5175# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5176 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
5177# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5178 ! Variables to describe initial condition of jet
5179# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5180 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
5181# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5182 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
5183# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5184 real(wp), dimension(0:n,0:p) :: rcut_arr
5185# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5186 integer :: l, q, s !< Iterators for reading input files
5187# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5188 integer :: start, end !< Ints to keep track of position in file
5189# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5190 character(len=1000) :: line !< String to store line in file
5191# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5192 character(len=25) :: value !< String to store value in line
5193# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5194 integer :: NJet !< Number of jets
5195# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5196
5197# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5198 eps = 1e-9_wp
5199# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5200
5201# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5202 if (patch_icpp(patch_id)%hcid == 303) then
5203# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5204 eps_smooth = 3._wp
5205# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5206 open (unit=10, file="njet.txt", status="old", action="read")
5207# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5208 read (10, *) njet
5209# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5210 close (10)
5211# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5212
5213# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5214 allocate (y_th_arr(0:njet - 1))
5215# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5216 allocate (z_th_arr(0:njet - 1))
5217# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5218 allocate (r_th_arr(0:njet - 1))
5219# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5220
5221# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5222 open (unit=10, file="jets.csv", status="old", action="read")
5223# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5224 do q = 0, njet - 1
5225# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5226 read (10, '(A)') line ! Read a full line as a string
5227# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5228 start = 1
5229# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5230
5231# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5232 do l = 0, 2
5233# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5234 end = index(line(start:), ',') ! Find the next comma
5235# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5236 if (end == 0) then
5237# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5238 value = trim(adjustl(line(start:))) ! Last value in the line
5239# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5240 else
5241# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5242 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
5243# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5244 start = start + end ! Move to next value
5245# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5246 end if
5247# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5248 if (l == 0) then
5249# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5250 read (value, *) y_th_arr(q) ! Convert string to numeric value
5251# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5252 else if (l == 1) then
5253# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5254 read (value, *) z_th_arr(q)
5255# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5256 else
5257# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5258 read (value, *) r_th_arr(q)
5259# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5260 end if
5261# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5262 end do
5263# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5264 end do
5265# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5266 close (10)
5267# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5268
5269# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5270 do q = 0, p
5271# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5272 do l = 0, n
5273# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5274 rcut = 0._wp
5275# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5276 do s = 0, njet - 1
5277# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5278 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
5279# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5280 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
5281# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5282 end do
5283# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5284 rcut_arr(l, q) = rcut
5285# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5286 end do
5287# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5288 end do
5289# 418 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5290 end if
5291
5292 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
5293 x_centroid = patch_icpp(patch_id)%x_centroid
5294 y_centroid = patch_icpp(patch_id)%y_centroid
5295 z_centroid = patch_icpp(patch_id)%z_centroid
5296 length_z = patch_icpp(patch_id)%length_z
5297 radius = patch_icpp(patch_id)%radius
5298 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5299 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5300 thickness = patch_icpp(patch_id)%epsilon
5301
5302 ! Initialize eta=1; modified if smoothing is enabled
5303 eta = 1._wp
5304
5305 ! write for all z
5306
5307 ! Assign patch vars if cell is covered and patch has write permission
5308 do k = 0, p
5309 do j = 0, n
5310 do i = 0, m
5311 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
5312
5313 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
5314 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
5315 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
5316
5317
5318 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5319 select case (patch_icpp(patch_id)%hcid)
5320# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5321 case (300) ! Rayleigh-Taylor instability
5322# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5323 rhoh = 3._wp
5324# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5325 rhol = 1._wp
5326# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5327 pref = 1.e5_wp
5328# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5329 pint = pref
5330# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5331 h = 0.7_wp
5332# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5333 lam = 0.2_wp
5334# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5335 wl = 2._wp*pi/lam
5336# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5337 amp = 0.025_wp/wl
5338# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5339
5340# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5341 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
5342# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5343
5344# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5345 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5346# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5347
5348# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5349 if (alph < eps) alph = eps
5350# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5351 if (alph > 1._wp - eps) alph = 1._wp - eps
5352# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5353
5354# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5355 if (y_cc(j) > inth) then
5356# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5357 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5358# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5359 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5360# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5361 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5362# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5363 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5364# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5365 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5366# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5367 else
5368# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5369 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5370# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5371 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5372# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5373 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5374# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5375 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5376# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5377 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5378# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5379 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
5380# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5381 end if
5382# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5383 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
5384# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5385 h = 0.0_wp
5386# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5387 lam = 1.0_wp
5388# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5389 amp = patch_icpp(patch_id)%a(2)
5390# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5391 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
5392# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5393 if (x_cc(i) > inth) then
5394# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5395 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
5396# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5397 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
5398# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5399 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
5400# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5401 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
5402# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5403 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
5404# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5405 end if
5406# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5407 case (302) ! 3D Jet with IGR
5408# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5409 ux_th = 10*sqrt(1.4*0.4)
5410# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5411 ux_am = 0.0*sqrt(1.4)
5412# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5413 p_th = 2.0_wp
5414# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5415 p_am = 1.0_wp
5416# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5417 rho_th = 1._wp
5418# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5419 rho_am = 1._wp
5420# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5421 y_th = 0.0_wp
5422# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5423 z_th = 0.0_wp
5424# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5425 r_th = 1._wp
5426# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5427 eps_smooth = 1._wp
5428# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5429 eps = 1e-6
5430# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5431
5432# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5433 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
5434# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5435 rcut = f_cut_on(r - r_th, eps_smooth)
5436# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5437 xcut = f_cut_on(x_cc(i), eps_smooth)
5438# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5439
5440# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5441 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5442# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5443 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5444# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5445 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5446# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5447
5448# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5449 if (num_fluids == 1) then
5450# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5451 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5452# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5453 else
5454# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5455 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5456# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5457 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5458# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5459 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
5460# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5461 end if
5462# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5463
5464# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5465 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5466# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5467 case (303) ! 3D Multijet
5468# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5469 eps_smooth = 3.0_wp
5470# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5471 ux_th = 10*sqrt(1.4*0.4)
5472# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5473 ux_am = 2.5*sqrt(1.4*0.4)
5474# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5475 p_th = 0.8_wp
5476# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5477 p_am = 0.4_wp
5478# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5479 rho_th = 1._wp
5480# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5481 rho_am = 1._wp
5482# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5483 eps = 1e-6
5484# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5485
5486# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5487 rcut = rcut_arr(j, k)
5488# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5489 xcut = f_cut_on(x_cc(i), eps_smooth)
5490# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5491
5492# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5493 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5494# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5495 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5496# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5497 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5498# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5499
5500# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5501 if (num_fluids == 1) then
5502# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5503 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5504# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5505 else
5506# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5507 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5508# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5509 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5510# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5511 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
5512# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5513 end if
5514# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5515
5516# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5517 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5518# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5519 case (370) ! 3D extrusion of 2D profile from external data
5520# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5521 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
5522# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5523 if (.not. files_loaded) then
5524# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5525 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5526# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5527 do f = 1, max_files
5528# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5529 write (file_num_str, '(I0)') f
5530# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5531 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
5532# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5533 end do
5534# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5535
5536# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5537 ! Common file reading setup
5538# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5539 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5540# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5541 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5542# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5543
5544# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5545 select case (num_dims)
5546# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5547 case (1, 2) ! 1D and 2D cases are similar
5548# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5549 ! Count lines
5550# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5551 line_count = 0
5552# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5553 do
5554# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5555 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5556# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5557 if (ios2 /= 0) exit
5558# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5559 line_count = line_count + 1
5560# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5561 end do
5562# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5563 close (unit2)
5564# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5565
5566# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5567 xrows = line_count
5568# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5569 yrows = 1
5570# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5571 index_x = 0
5572# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5573 if (num_dims == 2) index_x = i
5574# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5575#ifdef MFC_DEBUG
5576# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5577 block
5578# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5579 use iso_fortran_env, only: output_unit
5580# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5581
5582# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5583 print *, 'm_icpp_patches.fpp:447: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5584# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5585
5586# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5587 call flush (output_unit)
5588# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5589 end block
5590# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5591#endif
5592# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5593 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5594# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5595
5596# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5597
5598# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5599
5600# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5601#if defined(MFC_OpenACC)
5602# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5603!$acc enter data create(x_coords, stored_values)
5604# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5605#elif defined(MFC_OpenMP)
5606# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5607!$omp target enter data map(always,alloc:x_coords, stored_values)
5608# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5609#endif
5610# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5611
5612# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5613 ! Read data from all files
5614# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5615 do f = 1, max_files
5616# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5617 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5618# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5619 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5620# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5621
5622# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5623 do iter = 1, xrows
5624# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5625 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5626# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5627 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5628# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5629 end do
5630# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5631 close (unit)
5632# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5633 end do
5634# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5635
5636# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5637 ! Calculate offsets
5638# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5639 domain_xstart = x_coords(1)
5640# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5641 x_step = x_cc(1) - x_cc(0)
5642# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5643 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)
5644# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5645 global_offset_x = nint(abs(delta_x)/x_step)
5646# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5647 case (3) ! 3D case - determine grid structure
5648# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5649 ! Find yRows by counting rows with same x
5650# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5651 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5652# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5653 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5654# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5655
5656# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5657 yrows = 1
5658# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5659 do
5660# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5661 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5662# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5663 if (ios2 /= 0) exit
5664# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5665 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5666# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5667 yrows = yrows + 1
5668# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5669 else
5670# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5671 exit
5672# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5673 end if
5674# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5675 end do
5676# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5677 close (unit2)
5678# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5679
5680# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5681 ! Count total rows
5682# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5683 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5684# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5685 nrows = 0
5686# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5687 do
5688# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5689 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5690# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5691 if (ios2 /= 0) exit
5692# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5693 nrows = nrows + 1
5694# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5695 end do
5696# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5697 close (unit2)
5698# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5699
5700# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5701 xrows = nrows/yrows
5702# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5703#ifdef MFC_DEBUG
5704# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5705 block
5706# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5707 use iso_fortran_env, only: output_unit
5708# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5709
5710# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5711 print *, 'm_icpp_patches.fpp:447: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5712# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5713
5714# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5715 call flush (output_unit)
5716# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5717 end block
5718# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5719#endif
5720# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5721 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5722# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5723
5724# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5725
5726# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5727
5728# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5729
5730# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5731#if defined(MFC_OpenACC)
5732# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5733!$acc enter data create(x_coords, y_coords, stored_values)
5734# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5735#elif defined(MFC_OpenMP)
5736# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5737!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5738# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5739#endif
5740# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5741 index_x = i
5742# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5743 index_y = j
5744# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5745
5746# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5747 ! Read all files
5748# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5749 do f = 1, max_files
5750# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5751 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5752# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5753 if (ios /= 0) then
5754# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5755 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5756# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5757 cycle
5758# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5759 end if
5760# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5761
5762# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5763 iter = 0
5764# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5765 do iix = 1, xrows
5766# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5767 do iiy = 1, yrows
5768# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5769 iter = iter + 1
5770# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5771 if (f == 1) then
5772# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5773 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5774# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5775 else
5776# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5777 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5778# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5779 end if
5780# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5781 if (ios /= 0) call s_mpi_abort("Error reading data")
5782# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5783 end do
5784# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5785 end do
5786# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5787 close (unit)
5788# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5789 end do
5790# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5791
5792# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5793 ! Calculate offsets
5794# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5795 x_step = x_cc(1) - x_cc(0)
5796# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5797 y_step = y_cc(1) - y_cc(0)
5798# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5799 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5800# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5801 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5802# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5803 global_offset_x = nint(abs(delta_x)/x_step)
5804# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5805 global_offset_y = nint(abs(delta_y)/y_step)
5806# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5807 end select
5808# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5809
5810# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5811 files_loaded = .true.
5812# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5813 end if
5814# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5815
5816# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5817 ! Data assignment
5818# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5819 select case (num_dims)
5820# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5821 case (1)
5822# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5823 idx = i + 1 + global_offset_x
5824# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5825 do f = 1, sys_size
5826# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5827 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5828# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5829 end do
5830# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5831 case (2)
5832# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5833 idx = i + 1 + global_offset_x - index_x
5834# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5835 do f = 1, sys_size - 1
5836# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5837 jump = merge(1, 0, f >= eqn_idx%mom%end)
5838# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5839 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5840# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5841 end do
5842# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5843 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5844# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5845 case (3)
5846# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5847 idx = i + 1 + global_offset_x - index_x
5848# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5849 idy = j + 1 + global_offset_y - index_y
5850# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5851 do f = 1, sys_size - 1
5852# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5853 jump = merge(1, 0, f >= eqn_idx%mom%end)
5854# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5855 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5856# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5857 end do
5858# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5859 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5860# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5861 end select
5862# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5863 case (380) ! Taylor-Green vortex
5864# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5865 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
5866# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5867 ! geometry 9
5868# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5869 mach = 0.1
5870# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5871 if (patch_id == 1) then
5872# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5873 q_prim_vf(eqn_idx%E)%sf(i, j, &
5874# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5875 & 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)
5876# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5877 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
5878# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5879 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
5880# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5881 end if
5882# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5883 case default
5884# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5885 call s_int_to_str(patch_id, istr)
5886# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5887 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
5888# 447 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5889 end select
5890 end if
5891
5892 ! Updating the patch identities bookkeeping variable
5893 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5894
5895 q_prim_vf(eqn_idx%alf)%sf(i, j, &
5896 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5897 end if
5898 end do
5899 end do
5900 end do
5901 if (allocated(stored_values)) then
5902# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5903#ifdef MFC_DEBUG
5904# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5905 block
5906# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5907 use iso_fortran_env, only: output_unit
5908# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5909
5910# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5911 print *, 'm_icpp_patches.fpp:459: ', '@:DEALLOCATE(stored_values)'
5912# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5913
5914# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5915 call flush (output_unit)
5916# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5917 end block
5918# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5919#endif
5920# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5921
5922# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5923#if defined(MFC_OpenACC)
5924# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5925!$acc exit data delete(stored_values)
5926# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5927#elif defined(MFC_OpenMP)
5928# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5929!$omp target exit data map(release:stored_values)
5930# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5931#endif
5932# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5933 deallocate (stored_values)
5934# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5935#ifdef MFC_DEBUG
5936# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5937 block
5938# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5939 use iso_fortran_env, only: output_unit
5940# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5941
5942# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5943 print *, 'm_icpp_patches.fpp:459: ', '@:DEALLOCATE(x_coords)'
5944# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5945
5946# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5947 call flush (output_unit)
5948# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5949 end block
5950# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5951#endif
5952# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5953
5954# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5955#if defined(MFC_OpenACC)
5956# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5957!$acc exit data delete(x_coords)
5958# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5959#elif defined(MFC_OpenMP)
5960# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5961!$omp target exit data map(release:x_coords)
5962# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5963#endif
5964# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5965 deallocate (x_coords)
5966# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5967 end if
5968# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5969
5970# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5971 if (allocated(y_coords)) then
5972# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5973#ifdef MFC_DEBUG
5974# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5975 block
5976# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5977 use iso_fortran_env, only: output_unit
5978# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5979
5980# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5981 print *, 'm_icpp_patches.fpp:459: ', '@:DEALLOCATE(y_coords)'
5982# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5983
5984# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5985 call flush (output_unit)
5986# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5987 end block
5988# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5989#endif
5990# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5991
5992# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5993#if defined(MFC_OpenACC)
5994# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5995!$acc exit data delete(y_coords)
5996# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5997#elif defined(MFC_OpenMP)
5998# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5999!$omp target exit data map(release:y_coords)
6000# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6001#endif
6002# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6003 deallocate (y_coords)
6004# 459 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6005 end if
6006
6007 end subroutine s_icpp_3dvarcircle
6008
6009 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
6010 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
6011 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
6012
6013 integer, intent(in) :: patch_id
6014
6015#ifdef MFC_MIXED_PRECISION
6016 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6017#else
6018 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6019#endif
6020 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
6021 integer :: i, j, k !< Generic loop operators
6022 real(wp) :: a, b
6023
6024 integer :: xRows, yRows, nRows, iix, iiy, max_files
6025# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
6027# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028 real(wp) :: x_len, x_step, y_len, y_step
6029# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
6031# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
6033# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034 real(wp) :: delta_x, delta_y
6035# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6036 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
6037# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6038 character(len=200) :: errmsg
6039# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 real(wp), allocatable :: stored_values(:,:,:)
6041# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 real(wp), allocatable :: x_coords(:), y_coords(:)
6043# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 logical :: files_loaded = .false.
6045# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6046 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
6047# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6048 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
6049# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6050 character(len=20) :: file_num_str !< For storing the file number as a string
6051# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6052 character(len=20) :: zeros_part !< For the trailing zeros part
6053# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
6055 ! Place any declaration of intermediate variables here
6056# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6057 real(wp) :: eps, eps_mhd, C_mhd
6058# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6059 real(wp) :: r, rmax, gam, umax, p0
6060# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6061 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
6062# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6063 real(wp) :: factor
6064# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6065 real(wp) :: r0, alpha, r2
6066# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6067 real(wp) :: sinA, cosA
6068# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6069 real(wp) :: r_sq
6070# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6071
6072# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6073 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
6074# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6075 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
6076# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6077 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
6078# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6079 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
6080# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6081 integer :: igq, jgq
6082# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6083
6084# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6085 ! # 291 - Shear/Thermal Layer Case
6086# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6087 real(wp) :: delta_shear, u_max, u_mean
6088# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6089 real(wp) :: T_wall, T_inf, P_atm, T_loc
6090# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6091 real(wp) :: delta_th, R_mix
6092# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6093 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
6094# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6095 real(wp) :: bottom_blend_u, bottom_blend_T
6096# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6097
6098# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6099 ! # 207
6100# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6101 real(wp) :: sigma, gauss1, gauss2
6102# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6103
6104# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6105 ! # 208
6106# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6107 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
6108# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6109
6110# 479 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6111 eps = 1.e-9_wp
6112
6113 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
6114 x_centroid = patch_icpp(patch_id)%x_centroid
6115 y_centroid = patch_icpp(patch_id)%y_centroid
6116 a = patch_icpp(patch_id)%radii(1)
6117 b = patch_icpp(patch_id)%radii(2)
6118 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
6119 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
6120
6121 ! Initialize eta=1; modified if smoothing is enabled
6122 eta = 1._wp
6123
6124 ! Assign patch vars if cell is covered and patch has write permission
6125 do j = 0, n
6126 do i = 0, m
6127 if (patch_icpp(patch_id)%smoothen) then
6128 eta = tanh(smooth_coeff/min(dx, &
6129 & dy)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
6130 & + 0.5_wp
6131 end if
6132
6133 if ((f_is_inside_ellipse(x_cc(i) - x_centroid, y_cc(j) - y_centroid, [2._wp*a, 2._wp*b, &
6134 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
6135 & 0) == smooth_patch_id) then
6136 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
6137
6138
6139 if (patch_icpp(patch_id)%hcid /= dflt_int) then
6140 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
6141# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142 case (200) ! Two-fluid cubic interface
6143# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
6145# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146 ! Volume Fractions
6147# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6148 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
6149# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6150 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
6151# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
6153# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
6155# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
6157# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158 end if
6159# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
6161# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6163# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164 rmax = 0.2_wp
6165# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166
6167# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6169# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6171# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6173# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174
6175# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176 if (r < rmax) then
6177# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6179# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6181# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6183# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 else if (r < 2*rmax) then
6185# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6187# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6189# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
6191# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192 else
6193# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6195# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6197# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
6199# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 end if
6201# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
6203# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6205# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206 rmax = 0.2_wp
6207# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208
6209# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6211# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6213# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6215# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216
6217# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218 if (r < rmax) then
6219# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6221# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6223# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6225# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226 else if (r < 2*rmax) then
6227# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6229# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6231# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
6233# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234 else
6235# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6237# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6239# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
6241# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 end if
6243# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244
6245# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
6247# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248 case (204) ! Rayleigh-Taylor instability
6249# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 rhoh = 3._wp
6251# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252 rhol = 1._wp
6253# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254 pref = 1.e5_wp
6255# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256 pint = pref
6257# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258 h = 0.7_wp
6259# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260 lam = 0.2_wp
6261# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 wl = 2._wp*pi/lam
6263# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264 amp = 0.05_wp/wl
6265# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266
6267# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
6269# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270
6271# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6273# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274
6275# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 if (alph < eps) alph = eps
6277# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 if (alph > 1._wp - eps) alph = 1._wp - eps
6279# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280
6281# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 if (y_cc(j) > inth) then
6283# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6285# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6287# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6289# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6291# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6293# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 else
6295# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6297# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6299# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6301# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6303# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6305# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
6307# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308 end if
6309# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 case (205) ! 2D lung wave interaction problem
6311# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312 h = 0.0_wp ! non dim origin y
6313# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 lam = 1.0_wp ! non dim lambda
6315# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
6317# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318
6319# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
6321# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322
6323# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 if (y_cc(j) > inth) then
6325# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6327# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6329# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6331# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6333# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6335# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6336 end if
6337# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6338 case (206) ! 2D lung wave interaction problem - horizontal domain
6339# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340 h = 0.0_wp ! non dim origin y
6341# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6342 lam = 1.0_wp ! non dim lambda
6343# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6344 amp = patch_icpp(patch_id)%a(2)
6345# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346
6347# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
6349# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350
6351# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352 if (x_cc(i) > intl) then ! this is the liquid
6353# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6355# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6357# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6359# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6361# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6363# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364 end if
6365# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 case (207) ! Kelvin Helmholtz Instability
6367# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 sigma = 0.05_wp/sqrt(2.0_wp)
6369# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
6371# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
6373# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
6375# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 case (208) ! Richtmeyer Meshkov Instability
6377# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378 lam = 1.0_wp
6379# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 eps = 1.0e-6_wp
6381# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382 ei = 5.0_wp
6383# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 ! Smoothening function to smooth out sharp discontinuity in the interface
6385# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386 if (x_cc(i) <= 0.7_wp*lam) then
6387# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
6389# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
6391# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
6393# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 alpha_sf6 = 1.0_wp - alpha_air
6395# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
6397# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
6399# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
6401# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6402 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
6403# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6404 end if
6405# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 case (250) ! MHD Orszag-Tang vortex
6407# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408 ! 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),
6409# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 ! sin(4*pi*x)/sqrt(4*pi), 0)
6411# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412
6413# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
6415# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
6417# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418
6419# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
6421# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
6423# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
6425# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
6427# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6428 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
6429# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6430 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
6431# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
6433# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 ! Linear interpolation between r=0.08 and r=1.0
6435# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6436 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
6437# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
6439# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
6441# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442 else
6443# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
6445# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
6447# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 end if
6449# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450
6451# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6452 ! case 252 is for the 2D MHD Rotor problem
6453# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6454 case (252) ! 2D MHD Rotor Problem
6455# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
6457# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458 !
6459# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460 ! 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
6461# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462 ! velocity w=20, giving v_tan=2 at r=0.1
6463# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464
6465# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 ! Calculate distance squared from the center
6467# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
6469# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470
6471# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 ! inner radius of 0.1
6473# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 if (r_sq <= 0.1**2) then
6475# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 ! -- Inside the rotor -- Set density uniformly to 10
6477# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
6479# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480
6481# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
6483# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
6485# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
6487# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488
6489# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 ! taper width of 0.015
6491# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 else if (r_sq <= 0.115**2) then
6493# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494 ! linearly smooth the function between r = 0.1 and 0.115
6495# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6497# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498
6499# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6501# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6503# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6504 end if
6505# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6506 case (253) ! MHD Smooth Magnetic Vortex
6507# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
6509# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
6511# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512
6513# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514 ! velocity
6515# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6517# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6519# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520
6521# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522 ! magnetic field
6523# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6525# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6527# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528
6529# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530 ! pressure
6531# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532 q_prim_vf(eqn_idx%E)%sf(i, j, &
6533# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534 & 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)
6535# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536 case (260) ! Gaussian Divergence Pulse
6537# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
6539# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
6541# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542 ! initialized to zero everywhere.
6543# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544
6545# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 eps_mhd = patch_icpp(patch_id)%a(2)
6547# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6548 sigma = patch_icpp(patch_id)%a(3)
6549# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6550 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
6551# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552
6553# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6554 ! B-field
6555# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6556 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6557# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558 case (261) ! Blob
6559# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 r0 = 1._wp/sqrt(8._wp)
6561# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 r2 = x_cc(i)**2 + y_cc(j)**2
6563# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564 r = sqrt(r2)
6565# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 alpha = r/r0
6567# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568 if (alpha < 1) then
6569# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
6571# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
6573# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
6575# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
6577# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578 end if
6579# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
6581# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 ! rotate by \alpha = atan(2)
6583# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584 alpha = atan(2._wp)
6585# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586 cosa = cos(alpha)
6587# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588 sina = sin(alpha)
6589# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590 ! projection along shock normal
6591# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592 r = x_cc(i)*cosa + y_cc(j)*sina
6593# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6594
6595# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6596 if (r <= 0.5_wp) then
6597# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
6599# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6601# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
6603# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
6605# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
6607# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6609# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6611# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 else
6613# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
6615# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6617# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
6619# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
6621# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
6623# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
6625# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
6627# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628 end if
6629# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 ! v^z and B^z remain zero by default
6631# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632 case (270) ! 2D extrusion of 1D profile from external data
6633# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6635# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 if (.not. files_loaded) then
6637# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6639# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 do f = 1, max_files
6641# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642 write (file_num_str, '(I0)') f
6643# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
6645# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646 end do
6647# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648
6649# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650 ! Common file reading setup
6651# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6653# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6655# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656
6657# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658 select case (num_dims)
6659# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 case (1, 2) ! 1D and 2D cases are similar
6661# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 ! Count lines
6663# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664 line_count = 0
6665# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 do
6667# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6669# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 if (ios2 /= 0) exit
6671# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672 line_count = line_count + 1
6673# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 end do
6675# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 close (unit2)
6677# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678
6679# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 xrows = line_count
6681# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 yrows = 1
6683# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 index_x = 0
6685# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 if (num_dims == 2) index_x = i
6687# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688#ifdef MFC_DEBUG
6689# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 block
6691# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 use iso_fortran_env, only: output_unit
6693# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694
6695# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696 print *, 'm_icpp_patches.fpp:508: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6697# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698
6699# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700 call flush (output_unit)
6701# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702 end block
6703# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704#endif
6705# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6707# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708
6709# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710
6711# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712
6713# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714#if defined(MFC_OpenACC)
6715# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716!$acc enter data create(x_coords, stored_values)
6717# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718#elif defined(MFC_OpenMP)
6719# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720!$omp target enter data map(always,alloc:x_coords, stored_values)
6721# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722#endif
6723# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724
6725# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726 ! Read data from all files
6727# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728 do f = 1, max_files
6729# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6731# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6733# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734
6735# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736 do iter = 1, xrows
6737# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6739# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6741# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 end do
6743# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 close (unit)
6745# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 end do
6747# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748
6749# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 ! Calculate offsets
6751# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 domain_xstart = x_coords(1)
6753# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 x_step = x_cc(1) - x_cc(0)
6755# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 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)
6757# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758 global_offset_x = nint(abs(delta_x)/x_step)
6759# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 case (3) ! 3D case - determine grid structure
6761# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 ! Find yRows by counting rows with same x
6763# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6765# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6767# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768
6769# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 yrows = 1
6771# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 do
6773# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6775# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 if (ios2 /= 0) exit
6777# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6779# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 yrows = yrows + 1
6781# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 else
6783# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 exit
6785# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 end if
6787# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 end do
6789# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 close (unit2)
6791# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792
6793# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 ! Count total rows
6795# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6797# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 nrows = 0
6799# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 do
6801# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6803# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 if (ios2 /= 0) exit
6805# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806 nrows = nrows + 1
6807# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808 end do
6809# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 close (unit2)
6811# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812
6813# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 xrows = nrows/yrows
6815# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816#ifdef MFC_DEBUG
6817# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 block
6819# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6820 use iso_fortran_env, only: output_unit
6821# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6822
6823# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6824 print *, 'm_icpp_patches.fpp:508: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6825# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6826
6827# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6828 call flush (output_unit)
6829# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6830 end block
6831# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6832#endif
6833# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6834 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6835# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6836
6837# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6838
6839# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6840
6841# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6842
6843# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6844#if defined(MFC_OpenACC)
6845# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6846!$acc enter data create(x_coords, y_coords, stored_values)
6847# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6848#elif defined(MFC_OpenMP)
6849# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6850!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6851# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6852#endif
6853# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6854 index_x = i
6855# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6856 index_y = j
6857# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6858
6859# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6860 ! Read all files
6861# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6862 do f = 1, max_files
6863# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6864 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6865# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6866 if (ios /= 0) then
6867# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6868 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6869# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6870 cycle
6871# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6872 end if
6873# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6874
6875# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6876 iter = 0
6877# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6878 do iix = 1, xrows
6879# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6880 do iiy = 1, yrows
6881# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6882 iter = iter + 1
6883# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6884 if (f == 1) then
6885# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6886 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6887# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6888 else
6889# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6890 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6891# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6892 end if
6893# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6894 if (ios /= 0) call s_mpi_abort("Error reading data")
6895# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6896 end do
6897# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6898 end do
6899# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6900 close (unit)
6901# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6902 end do
6903# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6904
6905# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6906 ! Calculate offsets
6907# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6908 x_step = x_cc(1) - x_cc(0)
6909# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6910 y_step = y_cc(1) - y_cc(0)
6911# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6912 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6913# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6914 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6915# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6916 global_offset_x = nint(abs(delta_x)/x_step)
6917# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6918 global_offset_y = nint(abs(delta_y)/y_step)
6919# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6920 end select
6921# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6922
6923# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6924 files_loaded = .true.
6925# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6926 end if
6927# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6928
6929# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6930 ! Data assignment
6931# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6932 select case (num_dims)
6933# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6934 case (1)
6935# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6936 idx = i + 1 + global_offset_x
6937# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6938 do f = 1, sys_size
6939# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6940 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6941# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6942 end do
6943# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6944 case (2)
6945# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6946 idx = i + 1 + global_offset_x - index_x
6947# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6948 do f = 1, sys_size - 1
6949# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6950 jump = merge(1, 0, f >= eqn_idx%mom%end)
6951# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6952 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6953# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6954 end do
6955# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6956 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6957# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6958 case (3)
6959# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6960 idx = i + 1 + global_offset_x - index_x
6961# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6962 idy = j + 1 + global_offset_y - index_y
6963# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6964 do f = 1, sys_size - 1
6965# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6966 jump = merge(1, 0, f >= eqn_idx%mom%end)
6967# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6968 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6969# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6970 end do
6971# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6972 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6973# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6974 end select
6975# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6976 case (280) ! Isentropic vortex
6977# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6978 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6979# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6980 ! geometry 2
6981# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6982 if (patch_id == 1) then
6983# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6984 q_prim_vf(eqn_idx%E)%sf(i, j, &
6985# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6986 & 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) &
6987# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6988 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6989# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6990 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6991# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6992 & 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) &
6993# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6994 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6995# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6997# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
6999# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
7001# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7003# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
7005# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
7007# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008 end if
7009# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010 case (281) ! Acoustic pulse
7011# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
7013# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014 ! geometry 2
7015# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 if (patch_id == 2) then
7017# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018 q_prim_vf(eqn_idx%E)%sf(i, j, &
7019# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 & 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))
7021# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7023# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024 & 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))
7025# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 end if
7027# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028 case (282) ! Zero-circulation vortex
7029# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
7031# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032 ! geometry 2
7033# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034 if (patch_id == 2) then
7035# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036 q_prim_vf(eqn_idx%E)%sf(i, j, &
7037# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038 & 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))
7039# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7041# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042 & 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))
7043# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
7045# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7047# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7048 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7049# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7050 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7051# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7052 end if
7053# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7054 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
7055# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7056 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
7057# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7058 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
7059# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7060 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
7061# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7062 ! patch_icpp(patch_id)%epsilon; defaults to 5.
7063# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7064 if (patch_id == 1) then
7065# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7066 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
7067# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7068 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
7069# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7070 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
7071# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7072 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
7073# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7074 do igq = 1, 3
7075# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7076 do jgq = 1, 3
7077# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7078 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
7079# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7080 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
7081# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7082 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
7083# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7084 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
7085# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7086 wq = gauss_w(igq)*gauss_w(jgq)
7087# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7088 rhoq = t_facq**1.4_wp
7089# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7090 pq = t_facq**2.4_wp
7091# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7092 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7093# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7094 & - r2q)
7095# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7096 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7097# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7098 & - r2q)
7099# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7100 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
7101# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7102 rho_avg = rho_avg + wq*rhoq
7103# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7104 rhou_avg = rhou_avg + wq*(rhoq*uq)
7105# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7106 rhov_avg = rhov_avg + wq*(rhoq*vq)
7107# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7108 e_avg = e_avg + wq*eq
7109# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7110 end do
7111# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7112 end do
7113# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7114 rho_avg = rho_avg*0.25_wp
7115# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7116 rhou_avg = rhou_avg*0.25_wp
7117# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7118 rhov_avg = rhov_avg*0.25_wp
7119# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7120 e_avg = e_avg*0.25_wp
7121# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7122 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
7123# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7124 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
7125# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7126 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
7127# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7128 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
7129# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7130 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
7131# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7132 end if
7133# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7134 case (291) ! Isothermal Flat Plate
7135# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7136 t_inf = 1125.0_wp
7137# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7138 t_wall = 600.0_wp
7139# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7140 p_atm = 101325.0_wp
7141# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7142
7143# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7144 ! Boundary/Shear Layer thicknesses
7145# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7146 delta_th = 0.0003_wp ! Thermal BL thickness
7147# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7148 delta_shear = 8e-3_wp ! Velocity BL thickness
7149# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7150
7151# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7152 u_max = 50.0_wp ! Freestream Velocity (m/s)
7153# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7154
7155# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7156 mw_n2 = 28.0134e-3_wp
7157# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7158 mw_o2 = 31.999e-3_wp
7159# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7160 y_n2 = 0.767_wp
7161# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7162 y_o2 = 0.233_wp
7163# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7164 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
7165# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7166 bottom_blend_u = tanh(y_cc(j)/delta_shear)
7167# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7168 bottom_blend_t = tanh(y_cc(j)/delta_th)
7169# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7170 u_mean = u_max*bottom_blend_u
7171# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7172 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
7173# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7174 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
7175# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7176 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
7177# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7178 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
7179# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7180 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
7181# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7182 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
7183# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7184 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
7185# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7186 case default
7187# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7188 if (proc_rank == 0) then
7189# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7190 call s_int_to_str(patch_id, istr)
7191# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7192 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
7193# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7194 end if
7195# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7196 end select
7197 end if
7198
7199 ! Updating the patch identities bookkeeping variable
7200 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
7201 end if
7202 end do
7203 end do
7204 if (allocated(stored_values)) then
7205# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7206#ifdef MFC_DEBUG
7207# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7208 block
7209# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7210 use iso_fortran_env, only: output_unit
7211# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7212
7213# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7214 print *, 'm_icpp_patches.fpp:516: ', '@:DEALLOCATE(stored_values)'
7215# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7216
7217# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7218 call flush (output_unit)
7219# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7220 end block
7221# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7222#endif
7223# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7224
7225# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7226#if defined(MFC_OpenACC)
7227# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7228!$acc exit data delete(stored_values)
7229# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7230#elif defined(MFC_OpenMP)
7231# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7232!$omp target exit data map(release:stored_values)
7233# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7234#endif
7235# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7236 deallocate (stored_values)
7237# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7238#ifdef MFC_DEBUG
7239# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7240 block
7241# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7242 use iso_fortran_env, only: output_unit
7243# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7244
7245# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7246 print *, 'm_icpp_patches.fpp:516: ', '@:DEALLOCATE(x_coords)'
7247# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7248
7249# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7250 call flush (output_unit)
7251# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7252 end block
7253# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7254#endif
7255# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7256
7257# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7258#if defined(MFC_OpenACC)
7259# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7260!$acc exit data delete(x_coords)
7261# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7262#elif defined(MFC_OpenMP)
7263# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7264!$omp target exit data map(release:x_coords)
7265# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7266#endif
7267# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7268 deallocate (x_coords)
7269# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7270 end if
7271# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7272
7273# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7274 if (allocated(y_coords)) then
7275# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7276#ifdef MFC_DEBUG
7277# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7278 block
7279# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7280 use iso_fortran_env, only: output_unit
7281# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7282
7283# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7284 print *, 'm_icpp_patches.fpp:516: ', '@:DEALLOCATE(y_coords)'
7285# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7286
7287# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7288 call flush (output_unit)
7289# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7290 end block
7291# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7292#endif
7293# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7294
7295# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7296#if defined(MFC_OpenACC)
7297# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7298!$acc exit data delete(y_coords)
7299# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7300#elif defined(MFC_OpenMP)
7301# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7302!$omp target exit data map(release:y_coords)
7303# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7304#endif
7305# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7306 deallocate (y_coords)
7307# 516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7308 end if
7309
7310 end subroutine s_icpp_ellipse
7311
7312 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
7313 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
7314 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
7315
7316 ! Patch identifier
7317 integer, intent(in) :: patch_id
7318
7319#ifdef MFC_MIXED_PRECISION
7320 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7321#else
7322 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7323#endif
7324 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7325
7326 ! Generic loop iterators
7327 integer :: i, j, k
7328 real(wp) :: a, b, c
7329
7330 integer :: xRows, yRows, nRows, iix, iiy, max_files
7331# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7332 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7333# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7334 real(wp) :: x_len, x_step, y_len, y_step
7335# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7336 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7337# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7338 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7339# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7340 real(wp) :: delta_x, delta_y
7341# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7342 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7343# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7344 character(len=200) :: errmsg
7345# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7346 real(wp), allocatable :: stored_values(:,:,:)
7347# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7348 real(wp), allocatable :: x_coords(:), y_coords(:)
7349# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7350 logical :: files_loaded = .false.
7351# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7352 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7353# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7354 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
7355# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7356 character(len=20) :: file_num_str !< For storing the file number as a string
7357# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7358 character(len=20) :: zeros_part !< For the trailing zeros part
7359# 538 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7360 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
7361 ! Place any declaration of intermediate variables here
7362# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7363 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
7364# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7365 real(wp) :: eps
7366# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7367
7368# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7369 ! IGR Jets Arrays to stor position and radii of jets from input file
7370# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7371 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
7372# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7373 ! Variables to describe initial condition of jet
7374# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7375 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
7376# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7377 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
7378# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7379 real(wp), dimension(0:n,0:p) :: rcut_arr
7380# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7381 integer :: l, q, s !< Iterators for reading input files
7382# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7383 integer :: start, end !< Ints to keep track of position in file
7384# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7385 character(len=1000) :: line !< String to store line in file
7386# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7387 character(len=25) :: value !< String to store value in line
7388# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7389 integer :: NJet !< Number of jets
7390# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7391
7392# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7393 eps = 1e-9_wp
7394# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7395
7396# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7397 if (patch_icpp(patch_id)%hcid == 303) then
7398# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7399 eps_smooth = 3._wp
7400# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7401 open (unit=10, file="njet.txt", status="old", action="read")
7402# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7403 read (10, *) njet
7404# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7405 close (10)
7406# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7407
7408# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7409 allocate (y_th_arr(0:njet - 1))
7410# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7411 allocate (z_th_arr(0:njet - 1))
7412# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7413 allocate (r_th_arr(0:njet - 1))
7414# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7415
7416# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7417 open (unit=10, file="jets.csv", status="old", action="read")
7418# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7419 do q = 0, njet - 1
7420# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7421 read (10, '(A)') line ! Read a full line as a string
7422# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7423 start = 1
7424# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7425
7426# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7427 do l = 0, 2
7428# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7429 end = index(line(start:), ',') ! Find the next comma
7430# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7431 if (end == 0) then
7432# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7433 value = trim(adjustl(line(start:))) ! Last value in the line
7434# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7435 else
7436# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7437 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
7438# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7439 start = start + end ! Move to next value
7440# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7441 end if
7442# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7443 if (l == 0) then
7444# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7445 read (value, *) y_th_arr(q) ! Convert string to numeric value
7446# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7447 else if (l == 1) then
7448# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7449 read (value, *) z_th_arr(q)
7450# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7451 else
7452# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7453 read (value, *) r_th_arr(q)
7454# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7455 end if
7456# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7457 end do
7458# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7459 end do
7460# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7461 close (10)
7462# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7463
7464# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7465 do q = 0, p
7466# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7467 do l = 0, n
7468# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7469 rcut = 0._wp
7470# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7471 do s = 0, njet - 1
7472# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7473 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
7474# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7475 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
7476# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7477 end do
7478# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7479 rcut_arr(l, q) = rcut
7480# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7481 end do
7482# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7483 end do
7484# 539 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7485 end if
7486
7487 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
7488 x_centroid = patch_icpp(patch_id)%x_centroid
7489 y_centroid = patch_icpp(patch_id)%y_centroid
7490 z_centroid = patch_icpp(patch_id)%z_centroid
7491 a = patch_icpp(patch_id)%radii(1)
7492 b = patch_icpp(patch_id)%radii(2)
7493 c = patch_icpp(patch_id)%radii(3)
7494 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7495 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7496
7497 ! Initialize eta=1; modified if smoothing is enabled
7498 eta = 1._wp
7499
7500 ! Assign patch vars if cell is covered and patch has write permission
7501 do k = 0, p
7502 do j = 0, n
7503 do i = 0, m
7504 if (grid_geometry == 3) then
7505 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
7506 else
7507 cart_y = y_cc(j)
7508 cart_z = z_cc(k)
7509 end if
7510
7511 if (patch_icpp(patch_id)%smoothen) then
7512 eta = tanh(smooth_coeff/min(dx, dy, &
7513 & dz)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
7514 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
7515 end if
7516
7517 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp &
7518 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
7519 & k) == smooth_patch_id) then
7520 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
7521
7522
7523 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7524 select case (patch_icpp(patch_id)%hcid)
7525# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7526 case (300) ! Rayleigh-Taylor instability
7527# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7528 rhoh = 3._wp
7529# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7530 rhol = 1._wp
7531# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7532 pref = 1.e5_wp
7533# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7534 pint = pref
7535# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7536 h = 0.7_wp
7537# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7538 lam = 0.2_wp
7539# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7540 wl = 2._wp*pi/lam
7541# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7542 amp = 0.025_wp/wl
7543# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7544
7545# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7546 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
7547# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7548
7549# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7550 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7551# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7552
7553# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7554 if (alph < eps) alph = eps
7555# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7556 if (alph > 1._wp - eps) alph = 1._wp - eps
7557# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7558
7559# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7560 if (y_cc(j) > inth) then
7561# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7562 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7563# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7564 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7565# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7566 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7567# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7568 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7569# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7570 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7571# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572 else
7573# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7575# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7577# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7579# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7581# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7583# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
7585# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586 end if
7587# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
7589# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590 h = 0.0_wp
7591# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592 lam = 1.0_wp
7593# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594 amp = patch_icpp(patch_id)%a(2)
7595# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
7597# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598 if (x_cc(i) > inth) then
7599# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7600 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
7601# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7602 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
7603# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7604 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
7605# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7606 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
7607# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7608 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
7609# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7610 end if
7611# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7612 case (302) ! 3D Jet with IGR
7613# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7614 ux_th = 10*sqrt(1.4*0.4)
7615# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7616 ux_am = 0.0*sqrt(1.4)
7617# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7618 p_th = 2.0_wp
7619# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7620 p_am = 1.0_wp
7621# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7622 rho_th = 1._wp
7623# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7624 rho_am = 1._wp
7625# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7626 y_th = 0.0_wp
7627# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7628 z_th = 0.0_wp
7629# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7630 r_th = 1._wp
7631# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 eps_smooth = 1._wp
7633# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634 eps = 1e-6
7635# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636
7637# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
7639# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640 rcut = f_cut_on(r - r_th, eps_smooth)
7641# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642 xcut = f_cut_on(x_cc(i), eps_smooth)
7643# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644
7645# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7647# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7649# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7651# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652
7653# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 if (num_fluids == 1) then
7655# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7657# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658 else
7659# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7661# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7663# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
7665# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 end if
7667# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668
7669# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7671# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 case (303) ! 3D Multijet
7673# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674 eps_smooth = 3.0_wp
7675# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 ux_th = 10*sqrt(1.4*0.4)
7677# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 ux_am = 2.5*sqrt(1.4*0.4)
7679# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680 p_th = 0.8_wp
7681# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 p_am = 0.4_wp
7683# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 rho_th = 1._wp
7685# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686 rho_am = 1._wp
7687# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688 eps = 1e-6
7689# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690
7691# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692 rcut = rcut_arr(j, k)
7693# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694 xcut = f_cut_on(x_cc(i), eps_smooth)
7695# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696
7697# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7699# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7701# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7703# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704
7705# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706 if (num_fluids == 1) then
7707# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7709# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710 else
7711# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7713# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7715# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
7717# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718 end if
7719# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720
7721# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7723# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724 case (370) ! 3D extrusion of 2D profile from external data
7725# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7727# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728 if (.not. files_loaded) then
7729# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7731# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732 do f = 1, max_files
7733# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734 write (file_num_str, '(I0)') f
7735# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
7737# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738 end do
7739# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740
7741# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 ! Common file reading setup
7743# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7745# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7747# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748
7749# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 select case (num_dims)
7751# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752 case (1, 2) ! 1D and 2D cases are similar
7753# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754 ! Count lines
7755# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756 line_count = 0
7757# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 do
7759# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7761# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 if (ios2 /= 0) exit
7763# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764 line_count = line_count + 1
7765# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 end do
7767# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 close (unit2)
7769# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770
7771# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 xrows = line_count
7773# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 yrows = 1
7775# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776 index_x = 0
7777# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 if (num_dims == 2) index_x = i
7779# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780#ifdef MFC_DEBUG
7781# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782 block
7783# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 use iso_fortran_env, only: output_unit
7785# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786
7787# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 print *, 'm_icpp_patches.fpp:578: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7789# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790
7791# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792 call flush (output_unit)
7793# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794 end block
7795# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796#endif
7797# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7799# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800
7801# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802
7803# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804
7805# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806#if defined(MFC_OpenACC)
7807# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808!$acc enter data create(x_coords, stored_values)
7809# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810#elif defined(MFC_OpenMP)
7811# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812!$omp target enter data map(always,alloc:x_coords, stored_values)
7813# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814#endif
7815# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816
7817# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 ! Read data from all files
7819# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 do f = 1, max_files
7821# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7823# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7825# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826
7827# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 do iter = 1, xrows
7829# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7831# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
7833# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 end do
7835# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836 close (unit)
7837# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838 end do
7839# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840
7841# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842 ! Calculate offsets
7843# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 domain_xstart = x_coords(1)
7845# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 x_step = x_cc(1) - x_cc(0)
7847# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 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)
7849# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850 global_offset_x = nint(abs(delta_x)/x_step)
7851# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 case (3) ! 3D case - determine grid structure
7853# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854 ! Find yRows by counting rows with same x
7855# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7857# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7859# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860
7861# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862 yrows = 1
7863# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 do
7865# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7867# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 if (ios2 /= 0) exit
7869# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
7871# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 yrows = yrows + 1
7873# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874 else
7875# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 exit
7877# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 end if
7879# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880 end do
7881# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 close (unit2)
7883# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884
7885# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886 ! Count total rows
7887# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7889# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890 nrows = 0
7891# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7892 do
7893# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7894 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7895# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7896 if (ios2 /= 0) exit
7897# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7898 nrows = nrows + 1
7899# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7900 end do
7901# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7902 close (unit2)
7903# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7904
7905# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7906 xrows = nrows/yrows
7907# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7908#ifdef MFC_DEBUG
7909# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7910 block
7911# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7912 use iso_fortran_env, only: output_unit
7913# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7914
7915# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7916 print *, 'm_icpp_patches.fpp:578: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7917# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7918
7919# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7920 call flush (output_unit)
7921# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7922 end block
7923# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7924#endif
7925# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7926 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7927# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7928
7929# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7930
7931# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7932
7933# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7934
7935# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7936#if defined(MFC_OpenACC)
7937# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7938!$acc enter data create(x_coords, y_coords, stored_values)
7939# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7940#elif defined(MFC_OpenMP)
7941# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7942!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7943# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7944#endif
7945# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7946 index_x = i
7947# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7948 index_y = j
7949# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7950
7951# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7952 ! Read all files
7953# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7954 do f = 1, max_files
7955# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7956 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7957# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7958 if (ios /= 0) then
7959# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7960 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7961# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7962 cycle
7963# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7964 end if
7965# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7966
7967# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7968 iter = 0
7969# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7970 do iix = 1, xrows
7971# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7972 do iiy = 1, yrows
7973# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7974 iter = iter + 1
7975# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7976 if (f == 1) then
7977# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7978 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7979# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7980 else
7981# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7982 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7983# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7984 end if
7985# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7986 if (ios /= 0) call s_mpi_abort("Error reading data")
7987# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7988 end do
7989# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7990 end do
7991# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7992 close (unit)
7993# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7994 end do
7995# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7996
7997# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7998 ! Calculate offsets
7999# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8000 x_step = x_cc(1) - x_cc(0)
8001# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8002 y_step = y_cc(1) - y_cc(0)
8003# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8004 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
8005# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8006 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
8007# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8008 global_offset_x = nint(abs(delta_x)/x_step)
8009# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8010 global_offset_y = nint(abs(delta_y)/y_step)
8011# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8012 end select
8013# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8014
8015# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8016 files_loaded = .true.
8017# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8018 end if
8019# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8020
8021# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8022 ! Data assignment
8023# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8024 select case (num_dims)
8025# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8026 case (1)
8027# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8028 idx = i + 1 + global_offset_x
8029# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8030 do f = 1, sys_size
8031# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8032 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8033# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8034 end do
8035# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 case (2)
8037# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 idx = i + 1 + global_offset_x - index_x
8039# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040 do f = 1, sys_size - 1
8041# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042 jump = merge(1, 0, f >= eqn_idx%mom%end)
8043# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8045# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046 end do
8047# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8049# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050 case (3)
8051# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052 idx = i + 1 + global_offset_x - index_x
8053# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054 idy = j + 1 + global_offset_y - index_y
8055# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056 do f = 1, sys_size - 1
8057# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058 jump = merge(1, 0, f >= eqn_idx%mom%end)
8059# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8061# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8062 end do
8063# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8064 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8065# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8066 end select
8067# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8068 case (380) ! Taylor-Green vortex
8069# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8070 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
8071# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8072 ! geometry 9
8073# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8074 mach = 0.1
8075# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8076 if (patch_id == 1) then
8077# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8078 q_prim_vf(eqn_idx%E)%sf(i, j, &
8079# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8080 & 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)
8081# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8082 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
8083# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8084 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
8085# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8086 end if
8087# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8088 case default
8089# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8090 call s_int_to_str(patch_id, istr)
8091# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8092 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
8093# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8094 end select
8095 end if
8096
8097 ! Updating the patch identities bookkeeping variable
8098 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
8099 end if
8100 end do
8101 end do
8102 end do
8103 if (allocated(stored_values)) then
8104# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8105#ifdef MFC_DEBUG
8106# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8107 block
8108# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8109 use iso_fortran_env, only: output_unit
8110# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8111
8112# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8113 print *, 'm_icpp_patches.fpp:587: ', '@:DEALLOCATE(stored_values)'
8114# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8115
8116# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8117 call flush (output_unit)
8118# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8119 end block
8120# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8121#endif
8122# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8123
8124# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8125#if defined(MFC_OpenACC)
8126# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8127!$acc exit data delete(stored_values)
8128# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8129#elif defined(MFC_OpenMP)
8130# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8131!$omp target exit data map(release:stored_values)
8132# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8133#endif
8134# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8135 deallocate (stored_values)
8136# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8137#ifdef MFC_DEBUG
8138# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8139 block
8140# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8141 use iso_fortran_env, only: output_unit
8142# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8143
8144# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8145 print *, 'm_icpp_patches.fpp:587: ', '@:DEALLOCATE(x_coords)'
8146# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8147
8148# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8149 call flush (output_unit)
8150# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8151 end block
8152# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8153#endif
8154# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8155
8156# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8157#if defined(MFC_OpenACC)
8158# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8159!$acc exit data delete(x_coords)
8160# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8161#elif defined(MFC_OpenMP)
8162# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8163!$omp target exit data map(release:x_coords)
8164# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8165#endif
8166# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8167 deallocate (x_coords)
8168# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8169 end if
8170# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8171
8172# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8173 if (allocated(y_coords)) then
8174# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8175#ifdef MFC_DEBUG
8176# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8177 block
8178# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8179 use iso_fortran_env, only: output_unit
8180# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8181
8182# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8183 print *, 'm_icpp_patches.fpp:587: ', '@:DEALLOCATE(y_coords)'
8184# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8185
8186# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8187 call flush (output_unit)
8188# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8189 end block
8190# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8191#endif
8192# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8193
8194# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8195#if defined(MFC_OpenACC)
8196# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8197!$acc exit data delete(y_coords)
8198# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8199#elif defined(MFC_OpenMP)
8200# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8201!$omp target exit data map(release:y_coords)
8202# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8203#endif
8204# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8205 deallocate (y_coords)
8206# 587 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8207 end if
8208
8209 end subroutine s_icpp_ellipsoid
8210
8211 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
8212 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
8213 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
8214 !! allow for the smoothing of its boundaries.
8215 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
8216
8217 integer, intent(in) :: patch_id
8218
8219#ifdef MFC_MIXED_PRECISION
8220 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8221#else
8222 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8223#endif
8224 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8225 integer :: i, j, k !< generic loop iterators
8226 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
8227
8228 integer :: xRows, yRows, nRows, iix, iiy, max_files
8229# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8230 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8231# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8232 real(wp) :: x_len, x_step, y_len, y_step
8233# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8234 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8235# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8236 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
8237# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8238 real(wp) :: delta_x, delta_y
8239# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8240 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
8241# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8242 character(len=200) :: errmsg
8243# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8244 real(wp), allocatable :: stored_values(:,:,:)
8245# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8246 real(wp), allocatable :: x_coords(:), y_coords(:)
8247# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8248 logical :: files_loaded = .false.
8249# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8250 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8251# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8252 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
8253# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8254 character(len=20) :: file_num_str !< For storing the file number as a string
8255# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8256 character(len=20) :: zeros_part !< For the trailing zeros part
8257# 608 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8258 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
8259 ! Place any declaration of intermediate variables here
8260# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8261 real(wp) :: eps, eps_mhd, C_mhd
8262# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8263 real(wp) :: r, rmax, gam, umax, p0
8264# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8265 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
8266# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8267 real(wp) :: factor
8268# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8269 real(wp) :: r0, alpha, r2
8270# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8271 real(wp) :: sinA, cosA
8272# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8273 real(wp) :: r_sq
8274# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8275
8276# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8277 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
8278# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8279 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
8280# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8281 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
8282# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8283 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
8284# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8285 integer :: igq, jgq
8286# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8287
8288# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8289 ! # 291 - Shear/Thermal Layer Case
8290# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8291 real(wp) :: delta_shear, u_max, u_mean
8292# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8293 real(wp) :: T_wall, T_inf, P_atm, T_loc
8294# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8295 real(wp) :: delta_th, R_mix
8296# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8297 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
8298# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8299 real(wp) :: bottom_blend_u, bottom_blend_T
8300# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8301
8302# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8303 ! # 207
8304# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8305 real(wp) :: sigma, gauss1, gauss2
8306# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8307
8308# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8309 ! # 208
8310# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8311 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
8312# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8313
8314# 609 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8315 eps = 1.e-9_wp
8316
8317 pi_inf = pi_infs(1)
8318 gamma = gammas(1)
8319 lit_gamma = gs_min(1)
8320
8321 ! Transferring the rectangle's centroid and length information
8322 x_centroid = patch_icpp(patch_id)%x_centroid
8323 y_centroid = patch_icpp(patch_id)%y_centroid
8324 length_x = patch_icpp(patch_id)%length_x
8325 length_y = patch_icpp(patch_id)%length_y
8326
8327 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
8328 x_boundary%beg = x_centroid - 0.5_wp*length_x
8329 x_boundary%end = x_centroid + 0.5_wp*length_x
8330 y_boundary%beg = y_centroid - 0.5_wp*length_y
8331 y_boundary%end = y_centroid + 0.5_wp*length_y
8332
8333 ! Set eta=1 (no smoothing for this patch type)
8334 eta = 1._wp
8335
8336 ! Assign patch vars if cell is covered and patch has write permission
8337 do j = 0, n
8338 do i = 0, m
8339 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, 0._wp])) then
8340 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
8341 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
8342
8343
8344
8345 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8346 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
8347# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8348 case (200) ! Two-fluid cubic interface
8349# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8350 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
8351# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8352 ! Volume Fractions
8353# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8354 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
8355# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8356 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
8357# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8358 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
8359# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8360 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
8361# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8362 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
8363# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8364 end if
8365# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8366 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
8367# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8368 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8369# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8370 rmax = 0.2_wp
8371# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8372
8373# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8374 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8375# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8376 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8377# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8378 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8379# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8380
8381# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8382 if (r < rmax) then
8383# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8384 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8385# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8386 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8387# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8388 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8389# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8390 else if (r < 2*rmax) then
8391# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8392 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8393# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8394 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8395# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8396 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
8397# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8398 else
8399# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8400 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8401# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8402 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8403# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8404 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
8405# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8406 end if
8407# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8408 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
8409# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8410 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8411# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8412 rmax = 0.2_wp
8413# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8414
8415# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8416 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8417# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8418 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8419# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8420 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8421# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8422
8423# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8424 if (r < rmax) then
8425# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8426 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8427# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8428 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8429# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8430 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8431# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8432 else if (r < 2*rmax) then
8433# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8434 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8435# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8436 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8437# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8438 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
8439# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8440 else
8441# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8442 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8443# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8444 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8445# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8446 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
8447# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8448 end if
8449# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8450
8451# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8452 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
8453# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8454 case (204) ! Rayleigh-Taylor instability
8455# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8456 rhoh = 3._wp
8457# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8458 rhol = 1._wp
8459# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8460 pref = 1.e5_wp
8461# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8462 pint = pref
8463# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8464 h = 0.7_wp
8465# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8466 lam = 0.2_wp
8467# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8468 wl = 2._wp*pi/lam
8469# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8470 amp = 0.05_wp/wl
8471# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8472
8473# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8474 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
8475# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8476
8477# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8478 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8479# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8480
8481# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8482 if (alph < eps) alph = eps
8483# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8484 if (alph > 1._wp - eps) alph = 1._wp - eps
8485# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8486
8487# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8488 if (y_cc(j) > inth) then
8489# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8490 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8491# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8492 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8493# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8494 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8495# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8496 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8497# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8498 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8499# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8500 else
8501# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8502 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8503# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8504 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8505# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8506 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8507# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8508 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8509# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8510 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8511# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8512 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
8513# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8514 end if
8515# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8516 case (205) ! 2D lung wave interaction problem
8517# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8518 h = 0.0_wp ! non dim origin y
8519# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8520 lam = 1.0_wp ! non dim lambda
8521# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8522 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
8523# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8524
8525# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8526 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
8527# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8528
8529# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8530 if (y_cc(j) > inth) then
8531# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8532 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8533# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8534 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8535# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8536 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8537# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8538 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8539# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8540 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8541# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8542 end if
8543# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8544 case (206) ! 2D lung wave interaction problem - horizontal domain
8545# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8546 h = 0.0_wp ! non dim origin y
8547# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8548 lam = 1.0_wp ! non dim lambda
8549# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8550 amp = patch_icpp(patch_id)%a(2)
8551# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8552
8553# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8554 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
8555# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8556
8557# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8558 if (x_cc(i) > intl) then ! this is the liquid
8559# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8560 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8561# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8562 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8563# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8564 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8565# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8566 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8567# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8568 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8569# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8570 end if
8571# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8572 case (207) ! Kelvin Helmholtz Instability
8573# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8574 sigma = 0.05_wp/sqrt(2.0_wp)
8575# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8576 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
8577# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8578 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
8579# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8580 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
8581# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8582 case (208) ! Richtmeyer Meshkov Instability
8583# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8584 lam = 1.0_wp
8585# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8586 eps = 1.0e-6_wp
8587# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8588 ei = 5.0_wp
8589# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8590 ! Smoothening function to smooth out sharp discontinuity in the interface
8591# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8592 if (x_cc(i) <= 0.7_wp*lam) then
8593# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8594 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
8595# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8596 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
8597# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8598 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
8599# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8600 alpha_sf6 = 1.0_wp - alpha_air
8601# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8602 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
8603# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8604 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
8605# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8606 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
8607# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8608 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
8609# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8610 end if
8611# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8612 case (250) ! MHD Orszag-Tang vortex
8613# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8614 ! 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),
8615# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8616 ! sin(4*pi*x)/sqrt(4*pi), 0)
8617# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8618
8619# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8620 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
8621# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8622 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
8623# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8624
8625# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8626 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
8627# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8628 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
8629# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8630 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
8631# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8632 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
8633# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8634 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
8635# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8636 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
8637# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8638 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
8639# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8640 ! Linear interpolation between r=0.08 and r=1.0
8641# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8642 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
8643# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8644 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
8645# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8646 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
8647# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8648 else
8649# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8650 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
8651# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8652 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
8653# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8654 end if
8655# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8656
8657# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8658 ! case 252 is for the 2D MHD Rotor problem
8659# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8660 case (252) ! 2D MHD Rotor Problem
8661# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8662 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
8663# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8664 !
8665# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8666 ! 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
8667# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8668 ! velocity w=20, giving v_tan=2 at r=0.1
8669# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8670
8671# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8672 ! Calculate distance squared from the center
8673# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8674 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
8675# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8676
8677# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8678 ! inner radius of 0.1
8679# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8680 if (r_sq <= 0.1**2) then
8681# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8682 ! -- Inside the rotor -- Set density uniformly to 10
8683# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8684 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
8685# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8686
8687# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8688 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
8689# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8690 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
8691# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8692 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
8693# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8694
8695# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8696 ! taper width of 0.015
8697# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8698 else if (r_sq <= 0.115**2) then
8699# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8700 ! linearly smooth the function between r = 0.1 and 0.115
8701# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8702 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8703# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8704
8705# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8706 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8707# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8708 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8709# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8710 end if
8711# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8712 case (253) ! MHD Smooth Magnetic Vortex
8713# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8714 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
8715# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8716 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8717# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8718
8719# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8720 ! velocity
8721# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8722 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8723# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8724 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8725# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8726
8727# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8728 ! magnetic field
8729# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8730 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8731# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8732 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8733# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8734
8735# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8736 ! pressure
8737# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8738 q_prim_vf(eqn_idx%E)%sf(i, j, &
8739# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8740 & 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)
8741# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8742 case (260) ! Gaussian Divergence Pulse
8743# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8744 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
8745# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8746 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
8747# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8748 ! initialized to zero everywhere.
8749# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8750
8751# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8752 eps_mhd = patch_icpp(patch_id)%a(2)
8753# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8754 sigma = patch_icpp(patch_id)%a(3)
8755# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8756 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8757# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8758
8759# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8760 ! B-field
8761# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8762 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8763# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8764 case (261) ! Blob
8765# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8766 r0 = 1._wp/sqrt(8._wp)
8767# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8768 r2 = x_cc(i)**2 + y_cc(j)**2
8769# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8770 r = sqrt(r2)
8771# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8772 alpha = r/r0
8773# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8774 if (alpha < 1) then
8775# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8776 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
8777# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8778 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
8779# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8780 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
8781# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8782 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
8783# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8784 end if
8785# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8786 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
8787# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8788 ! rotate by \alpha = atan(2)
8789# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8790 alpha = atan(2._wp)
8791# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8792 cosa = cos(alpha)
8793# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8794 sina = sin(alpha)
8795# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8796 ! projection along shock normal
8797# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8798 r = x_cc(i)*cosa + y_cc(j)*sina
8799# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8800
8801# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8802 if (r <= 0.5_wp) then
8803# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8804 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
8805# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8806 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8807# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8808 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
8809# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8810 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
8811# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8812 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
8813# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8814 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8815# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8816 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8817# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8818 else
8819# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8820 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
8821# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8822 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8823# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8824 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
8825# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8826 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
8827# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8828 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
8829# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8830 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
8831# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8832 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
8833# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8834 end if
8835# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8836 ! v^z and B^z remain zero by default
8837# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8838 case (270) ! 2D extrusion of 1D profile from external data
8839# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8840 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8841# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8842 if (.not. files_loaded) then
8843# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8844 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8845# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8846 do f = 1, max_files
8847# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8848 write (file_num_str, '(I0)') f
8849# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8850 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
8851# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8852 end do
8853# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8854
8855# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8856 ! Common file reading setup
8857# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8858 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8859# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8860 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8861# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8862
8863# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8864 select case (num_dims)
8865# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8866 case (1, 2) ! 1D and 2D cases are similar
8867# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8868 ! Count lines
8869# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8870 line_count = 0
8871# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8872 do
8873# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8874 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8875# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8876 if (ios2 /= 0) exit
8877# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8878 line_count = line_count + 1
8879# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8880 end do
8881# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8882 close (unit2)
8883# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8884
8885# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8886 xrows = line_count
8887# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8888 yrows = 1
8889# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8890 index_x = 0
8891# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8892 if (num_dims == 2) index_x = i
8893# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8894#ifdef MFC_DEBUG
8895# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8896 block
8897# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8898 use iso_fortran_env, only: output_unit
8899# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8900
8901# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8902 print *, 'm_icpp_patches.fpp:640: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8903# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8904
8905# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8906 call flush (output_unit)
8907# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8908 end block
8909# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8910#endif
8911# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8912 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8913# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8914
8915# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8916
8917# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8918
8919# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8920#if defined(MFC_OpenACC)
8921# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8922!$acc enter data create(x_coords, stored_values)
8923# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8924#elif defined(MFC_OpenMP)
8925# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8926!$omp target enter data map(always,alloc:x_coords, stored_values)
8927# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8928#endif
8929# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8930
8931# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8932 ! Read data from all files
8933# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8934 do f = 1, max_files
8935# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8936 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8937# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8938 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8939# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8940
8941# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8942 do iter = 1, xrows
8943# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8944 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8945# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8946 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8947# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8948 end do
8949# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8950 close (unit)
8951# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8952 end do
8953# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8954
8955# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8956 ! Calculate offsets
8957# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8958 domain_xstart = x_coords(1)
8959# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8960 x_step = x_cc(1) - x_cc(0)
8961# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8962 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)
8963# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8964 global_offset_x = nint(abs(delta_x)/x_step)
8965# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8966 case (3) ! 3D case - determine grid structure
8967# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8968 ! Find yRows by counting rows with same x
8969# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8970 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8971# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8972 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8973# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8974
8975# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8976 yrows = 1
8977# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8978 do
8979# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8980 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8981# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8982 if (ios2 /= 0) exit
8983# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8984 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8985# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8986 yrows = yrows + 1
8987# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8988 else
8989# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8990 exit
8991# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8992 end if
8993# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8994 end do
8995# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8996 close (unit2)
8997# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8998
8999# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9000 ! Count total rows
9001# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9002 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9003# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9004 nrows = 0
9005# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9006 do
9007# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9008 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9009# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9010 if (ios2 /= 0) exit
9011# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9012 nrows = nrows + 1
9013# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9014 end do
9015# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9016 close (unit2)
9017# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9018
9019# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9020 xrows = nrows/yrows
9021# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9022#ifdef MFC_DEBUG
9023# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9024 block
9025# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9026 use iso_fortran_env, only: output_unit
9027# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9028
9029# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9030 print *, 'm_icpp_patches.fpp:640: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9031# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9032
9033# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9034 call flush (output_unit)
9035# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9036 end block
9037# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9038#endif
9039# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9040 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9041# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9042
9043# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9044
9045# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9046
9047# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9048
9049# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9050#if defined(MFC_OpenACC)
9051# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9052!$acc enter data create(x_coords, y_coords, stored_values)
9053# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9054#elif defined(MFC_OpenMP)
9055# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9056!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9057# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9058#endif
9059# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9060 index_x = i
9061# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9062 index_y = j
9063# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9064
9065# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9066 ! Read all files
9067# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9068 do f = 1, max_files
9069# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9070 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9071# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9072 if (ios /= 0) then
9073# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9074 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9075# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9076 cycle
9077# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9078 end if
9079# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9080
9081# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9082 iter = 0
9083# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9084 do iix = 1, xrows
9085# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9086 do iiy = 1, yrows
9087# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9088 iter = iter + 1
9089# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9090 if (f == 1) then
9091# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9092 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9093# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9094 else
9095# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9096 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9097# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9098 end if
9099# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9100 if (ios /= 0) call s_mpi_abort("Error reading data")
9101# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9102 end do
9103# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9104 end do
9105# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9106 close (unit)
9107# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9108 end do
9109# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9110
9111# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9112 ! Calculate offsets
9113# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9114 x_step = x_cc(1) - x_cc(0)
9115# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9116 y_step = y_cc(1) - y_cc(0)
9117# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9118 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9119# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9120 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9121# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9122 global_offset_x = nint(abs(delta_x)/x_step)
9123# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9124 global_offset_y = nint(abs(delta_y)/y_step)
9125# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9126 end select
9127# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9128
9129# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9130 files_loaded = .true.
9131# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9132 end if
9133# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9134
9135# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9136 ! Data assignment
9137# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9138 select case (num_dims)
9139# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9140 case (1)
9141# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9142 idx = i + 1 + global_offset_x
9143# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9144 do f = 1, sys_size
9145# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9146 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9147# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9148 end do
9149# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9150 case (2)
9151# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9152 idx = i + 1 + global_offset_x - index_x
9153# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9154 do f = 1, sys_size - 1
9155# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9156 jump = merge(1, 0, f >= eqn_idx%mom%end)
9157# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9158 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9159# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9160 end do
9161# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9162 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9163# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9164 case (3)
9165# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9166 idx = i + 1 + global_offset_x - index_x
9167# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9168 idy = j + 1 + global_offset_y - index_y
9169# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9170 do f = 1, sys_size - 1
9171# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9172 jump = merge(1, 0, f >= eqn_idx%mom%end)
9173# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9174 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9175# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9176 end do
9177# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9178 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9179# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9180 end select
9181# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9182 case (280) ! Isentropic vortex
9183# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9184 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
9185# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9186 ! geometry 2
9187# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9188 if (patch_id == 1) then
9189# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9190 q_prim_vf(eqn_idx%E)%sf(i, j, &
9191# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9192 & 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) &
9193# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9194 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9195# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9196 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9197# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9198 & 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) &
9199# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9200 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9201# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9202 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9203# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9204 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
9205# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9206 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9207# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9208 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9209# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9210 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
9211# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9212 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9213# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9214 end if
9215# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9216 case (281) ! Acoustic pulse
9217# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9218 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
9219# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9220 ! geometry 2
9221# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9222 if (patch_id == 2) then
9223# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9224 q_prim_vf(eqn_idx%E)%sf(i, j, &
9225# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9226 & 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))
9227# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9228 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9229# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9230 & 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))
9231# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9232 end if
9233# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9234 case (282) ! Zero-circulation vortex
9235# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9236 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
9237# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9238 ! geometry 2
9239# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9240 if (patch_id == 2) then
9241# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9242 q_prim_vf(eqn_idx%E)%sf(i, j, &
9243# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9244 & 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))
9245# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9246 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9247# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9248 & 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))
9249# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9250 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9251# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9252 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9253# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9254 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9255# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9256 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9257# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9258 end if
9259# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9260 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
9261# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9262 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
9263# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9264 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
9265# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9266 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
9267# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9268 ! patch_icpp(patch_id)%epsilon; defaults to 5.
9269# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9270 if (patch_id == 1) then
9271# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9272 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
9273# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9274 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
9275# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9276 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
9277# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9278 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
9279# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9280 do igq = 1, 3
9281# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9282 do jgq = 1, 3
9283# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9284 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
9285# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9286 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
9287# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9288 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
9289# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9290 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
9291# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9292 wq = gauss_w(igq)*gauss_w(jgq)
9293# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9294 rhoq = t_facq**1.4_wp
9295# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9296 pq = t_facq**2.4_wp
9297# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9298 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9299# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9300 & - r2q)
9301# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9302 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9303# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9304 & - r2q)
9305# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9306 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
9307# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9308 rho_avg = rho_avg + wq*rhoq
9309# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9310 rhou_avg = rhou_avg + wq*(rhoq*uq)
9311# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9312 rhov_avg = rhov_avg + wq*(rhoq*vq)
9313# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9314 e_avg = e_avg + wq*eq
9315# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9316 end do
9317# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9318 end do
9319# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9320 rho_avg = rho_avg*0.25_wp
9321# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9322 rhou_avg = rhou_avg*0.25_wp
9323# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9324 rhov_avg = rhov_avg*0.25_wp
9325# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9326 e_avg = e_avg*0.25_wp
9327# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9328 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
9329# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9330 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
9331# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9332 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
9333# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9334 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
9335# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9336 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
9337# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9338 end if
9339# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9340 case (291) ! Isothermal Flat Plate
9341# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9342 t_inf = 1125.0_wp
9343# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9344 t_wall = 600.0_wp
9345# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9346 p_atm = 101325.0_wp
9347# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9348
9349# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9350 ! Boundary/Shear Layer thicknesses
9351# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9352 delta_th = 0.0003_wp ! Thermal BL thickness
9353# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9354 delta_shear = 8e-3_wp ! Velocity BL thickness
9355# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9356
9357# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9358 u_max = 50.0_wp ! Freestream Velocity (m/s)
9359# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9360
9361# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9362 mw_n2 = 28.0134e-3_wp
9363# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9364 mw_o2 = 31.999e-3_wp
9365# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9366 y_n2 = 0.767_wp
9367# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9368 y_o2 = 0.233_wp
9369# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9370 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
9371# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9372 bottom_blend_u = tanh(y_cc(j)/delta_shear)
9373# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9374 bottom_blend_t = tanh(y_cc(j)/delta_th)
9375# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9376 u_mean = u_max*bottom_blend_u
9377# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9378 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
9379# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9380 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
9381# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9382 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
9383# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9384 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9385# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9386 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
9387# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9388 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
9389# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9390 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
9391# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9392 case default
9393# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9394 if (proc_rank == 0) then
9395# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9396 call s_int_to_str(patch_id, istr)
9397# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9398 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
9399# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9400 end if
9401# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9402 end select
9403 end if
9404
9405 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == model_eqns_4eq)) then
9406 ! zero density, reassign according to Tait EOS
9407 q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(eqn_idx%E)%sf(i, j, &
9408 & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp &
9409 & - q_prim_vf(eqn_idx%alf)%sf(i, j, 0))
9410 end if
9411
9412 ! Updating the patch identities bookkeeping variable
9413 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9414 end if
9415 end if
9416 end do
9417 end do
9418 if (allocated(stored_values)) then
9419# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9420#ifdef MFC_DEBUG
9421# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9422 block
9423# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9424 use iso_fortran_env, only: output_unit
9425# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9426
9427# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9428 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(stored_values)'
9429# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9430
9431# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9432 call flush (output_unit)
9433# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9434 end block
9435# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9436#endif
9437# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9438
9439# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9440#if defined(MFC_OpenACC)
9441# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9442!$acc exit data delete(stored_values)
9443# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9444#elif defined(MFC_OpenMP)
9445# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9446!$omp target exit data map(release:stored_values)
9447# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9448#endif
9449# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9450 deallocate (stored_values)
9451# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9452#ifdef MFC_DEBUG
9453# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9454 block
9455# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9456 use iso_fortran_env, only: output_unit
9457# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9458
9459# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9460 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(x_coords)'
9461# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9462
9463# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9464 call flush (output_unit)
9465# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9466 end block
9467# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9468#endif
9469# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9470
9471# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9472#if defined(MFC_OpenACC)
9473# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9474!$acc exit data delete(x_coords)
9475# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9476#elif defined(MFC_OpenMP)
9477# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9478!$omp target exit data map(release:x_coords)
9479# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9480#endif
9481# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9482 deallocate (x_coords)
9483# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9484 end if
9485# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9486
9487# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9488 if (allocated(y_coords)) then
9489# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9490#ifdef MFC_DEBUG
9491# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9492 block
9493# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9494 use iso_fortran_env, only: output_unit
9495# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9496
9497# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9498 print *, 'm_icpp_patches.fpp:656: ', '@:DEALLOCATE(y_coords)'
9499# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9500
9501# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9502 call flush (output_unit)
9503# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9504 end block
9505# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9506#endif
9507# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9508
9509# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9510#if defined(MFC_OpenACC)
9511# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9512!$acc exit data delete(y_coords)
9513# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9514#elif defined(MFC_OpenMP)
9515# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9516!$omp target exit data map(release:y_coords)
9517# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9518#endif
9519# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9520 deallocate (y_coords)
9521# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9522 end if
9523
9524 end subroutine s_icpp_rectangle
9525
9526 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
9527 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
9528 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
9529 !! the smoothing of its boundary.
9530 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
9531
9532 integer, intent(in) :: patch_id
9533
9534#ifdef MFC_MIXED_PRECISION
9535 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9536#else
9537 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9538#endif
9539 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9540 integer :: i, j, k !< Generic loop operators
9541 real(wp) :: a, b, c
9542
9543 integer :: xRows, yRows, nRows, iix, iiy, max_files
9544# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9545 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9546# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9547 real(wp) :: x_len, x_step, y_len, y_step
9548# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9549 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9550# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9551 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
9552# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9553 real(wp) :: delta_x, delta_y
9554# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9555 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
9556# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9557 character(len=200) :: errmsg
9558# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9559 real(wp), allocatable :: stored_values(:,:,:)
9560# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9561 real(wp), allocatable :: x_coords(:), y_coords(:)
9562# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9563 logical :: files_loaded = .false.
9564# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9565 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9566# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9567 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
9568# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9569 character(len=20) :: file_num_str !< For storing the file number as a string
9570# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9571 character(len=20) :: zeros_part !< For the trailing zeros part
9572# 677 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9573 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
9574 ! Place any declaration of intermediate variables here
9575# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9576 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9577# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9578 real(wp) :: eps
9579# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9580
9581# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9582 ! IGR Jets Arrays to stor position and radii of jets from input file
9583# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9584 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9585# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9586 ! Variables to describe initial condition of jet
9587# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9588 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9589# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9590 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
9591# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9592 real(wp), dimension(0:n,0:p) :: rcut_arr
9593# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9594 integer :: l, q, s !< Iterators for reading input files
9595# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9596 integer :: start, end !< Ints to keep track of position in file
9597# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9598 character(len=1000) :: line !< String to store line in file
9599# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9600 character(len=25) :: value !< String to store value in line
9601# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9602 integer :: NJet !< Number of jets
9603# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9604
9605# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9606 eps = 1e-9_wp
9607# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9608
9609# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9610 if (patch_icpp(patch_id)%hcid == 303) then
9611# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 eps_smooth = 3._wp
9613# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614 open (unit=10, file="njet.txt", status="old", action="read")
9615# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616 read (10, *) njet
9617# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618 close (10)
9619# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620
9621# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622 allocate (y_th_arr(0:njet - 1))
9623# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624 allocate (z_th_arr(0:njet - 1))
9625# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626 allocate (r_th_arr(0:njet - 1))
9627# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628
9629# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630 open (unit=10, file="jets.csv", status="old", action="read")
9631# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 do q = 0, njet - 1
9633# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634 read (10, '(A)') line ! Read a full line as a string
9635# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636 start = 1
9637# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638
9639# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9640 do l = 0, 2
9641# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9642 end = index(line(start:), ',') ! Find the next comma
9643# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9644 if (end == 0) then
9645# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9646 value = trim(adjustl(line(start:))) ! Last value in the line
9647# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9648 else
9649# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9650 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
9651# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9652 start = start + end ! Move to next value
9653# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9654 end if
9655# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9656 if (l == 0) then
9657# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9658 read (value, *) y_th_arr(q) ! Convert string to numeric value
9659# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9660 else if (l == 1) then
9661# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9662 read (value, *) z_th_arr(q)
9663# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9664 else
9665# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9666 read (value, *) r_th_arr(q)
9667# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668 end if
9669# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 end do
9671# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 end do
9673# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674 close (10)
9675# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676
9677# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678 do q = 0, p
9679# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 do l = 0, n
9681# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682 rcut = 0._wp
9683# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684 do s = 0, njet - 1
9685# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
9687# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
9689# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690 end do
9691# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692 rcut_arr(l, q) = rcut
9693# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694 end do
9695# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696 end do
9697# 678 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9698 end if
9699
9700 ! Transferring the centroid information of the line to be swept
9701 x_centroid = patch_icpp(patch_id)%x_centroid
9702 y_centroid = patch_icpp(patch_id)%y_centroid
9703 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
9704 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
9705
9706 ! Obtaining coefficients of the equation describing the sweep line
9707 a = patch_icpp(patch_id)%normal(1)
9708 b = patch_icpp(patch_id)%normal(2)
9709 c = -a*x_centroid - b*y_centroid
9710
9711 ! Initialize eta=1; modified if smoothing is enabled
9712 eta = 1._wp
9713
9714 ! Assign patch vars if cell is covered and patch has write permission
9715 do j = 0, n
9716 do i = 0, m
9717 if (patch_icpp(patch_id)%smoothen) then
9718 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))
9719 end if
9720
9721 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
9722 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
9723 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
9724
9725
9726 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9727 select case (patch_icpp(patch_id)%hcid)
9728# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9729 case (300) ! Rayleigh-Taylor instability
9730# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9731 rhoh = 3._wp
9732# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9733 rhol = 1._wp
9734# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9735 pref = 1.e5_wp
9736# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9737 pint = pref
9738# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9739 h = 0.7_wp
9740# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9741 lam = 0.2_wp
9742# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9743 wl = 2._wp*pi/lam
9744# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9745 amp = 0.025_wp/wl
9746# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9747
9748# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9749 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
9750# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9751
9752# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9753 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9754# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9755
9756# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9757 if (alph < eps) alph = eps
9758# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9759 if (alph > 1._wp - eps) alph = 1._wp - eps
9760# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9761
9762# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9763 if (y_cc(j) > inth) then
9764# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9765 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9766# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9767 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9768# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9769 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9770# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9771 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9772# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9773 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9774# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9775 else
9776# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9777 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9778# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9779 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9780# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9781 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9782# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9783 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9784# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9785 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9786# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9787 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
9788# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9789 end if
9790# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9791 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
9792# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9793 h = 0.0_wp
9794# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9795 lam = 1.0_wp
9796# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9797 amp = patch_icpp(patch_id)%a(2)
9798# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9799 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
9800# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9801 if (x_cc(i) > inth) then
9802# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9803 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
9804# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9805 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
9806# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9807 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
9808# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9809 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
9810# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9811 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
9812# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9813 end if
9814# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9815 case (302) ! 3D Jet with IGR
9816# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9817 ux_th = 10*sqrt(1.4*0.4)
9818# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9819 ux_am = 0.0*sqrt(1.4)
9820# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9821 p_th = 2.0_wp
9822# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9823 p_am = 1.0_wp
9824# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9825 rho_th = 1._wp
9826# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9827 rho_am = 1._wp
9828# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9829 y_th = 0.0_wp
9830# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9831 z_th = 0.0_wp
9832# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9833 r_th = 1._wp
9834# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9835 eps_smooth = 1._wp
9836# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9837 eps = 1e-6
9838# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9839
9840# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9841 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
9842# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9843 rcut = f_cut_on(r - r_th, eps_smooth)
9844# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9845 xcut = f_cut_on(x_cc(i), eps_smooth)
9846# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9847
9848# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9849 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9850# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9851 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9852# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9853 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9854# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9855
9856# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9857 if (num_fluids == 1) then
9858# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9859 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9860# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9861 else
9862# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9863 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9864# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9865 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9866# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9867 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
9868# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9869 end if
9870# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9871
9872# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9873 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9874# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9875 case (303) ! 3D Multijet
9876# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9877 eps_smooth = 3.0_wp
9878# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9879 ux_th = 10*sqrt(1.4*0.4)
9880# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9881 ux_am = 2.5*sqrt(1.4*0.4)
9882# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9883 p_th = 0.8_wp
9884# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9885 p_am = 0.4_wp
9886# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9887 rho_th = 1._wp
9888# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9889 rho_am = 1._wp
9890# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9891 eps = 1e-6
9892# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9893
9894# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9895 rcut = rcut_arr(j, k)
9896# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9897 xcut = f_cut_on(x_cc(i), eps_smooth)
9898# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9899
9900# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9901 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9902# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9903 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9904# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9905 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9906# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9907
9908# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9909 if (num_fluids == 1) then
9910# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9911 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9912# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9913 else
9914# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9915 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9916# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9917 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9918# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9919 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
9920# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9921 end if
9922# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9923
9924# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9925 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9926# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9927 case (370) ! 3D extrusion of 2D profile from external data
9928# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9929 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9930# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9931 if (.not. files_loaded) then
9932# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9933 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9934# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9935 do f = 1, max_files
9936# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9937 write (file_num_str, '(I0)') f
9938# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9939 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
9940# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9941 end do
9942# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9943
9944# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9945 ! Common file reading setup
9946# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9947 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9948# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9949 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9950# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9951
9952# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9953 select case (num_dims)
9954# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9955 case (1, 2) ! 1D and 2D cases are similar
9956# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9957 ! Count lines
9958# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9959 line_count = 0
9960# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9961 do
9962# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9963 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9964# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9965 if (ios2 /= 0) exit
9966# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9967 line_count = line_count + 1
9968# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9969 end do
9970# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9971 close (unit2)
9972# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9973
9974# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9975 xrows = line_count
9976# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9977 yrows = 1
9978# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9979 index_x = 0
9980# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9981 if (num_dims == 2) index_x = i
9982# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9983#ifdef MFC_DEBUG
9984# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9985 block
9986# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9987 use iso_fortran_env, only: output_unit
9988# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9989
9990# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9991 print *, 'm_icpp_patches.fpp:707: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9992# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9993
9994# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9995 call flush (output_unit)
9996# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9997 end block
9998# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9999#endif
10000# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10001 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10002# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10003
10004# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10005
10006# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10007
10008# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10009#if defined(MFC_OpenACC)
10010# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10011!$acc enter data create(x_coords, stored_values)
10012# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10013#elif defined(MFC_OpenMP)
10014# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10015!$omp target enter data map(always,alloc:x_coords, stored_values)
10016# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10017#endif
10018# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10019
10020# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10021 ! Read data from all files
10022# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10023 do f = 1, max_files
10024# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10025 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10026# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10027 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10028# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10029
10030# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10031 do iter = 1, xrows
10032# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10033 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10034# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10035 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10036# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10037 end do
10038# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10039 close (unit)
10040# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10041 end do
10042# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10043
10044# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10045 ! Calculate offsets
10046# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10047 domain_xstart = x_coords(1)
10048# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10049 x_step = x_cc(1) - x_cc(0)
10050# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10051 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)
10052# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10053 global_offset_x = nint(abs(delta_x)/x_step)
10054# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10055 case (3) ! 3D case - determine grid structure
10056# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10057 ! Find yRows by counting rows with same x
10058# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10059 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10060# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10061 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10062# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10063
10064# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10065 yrows = 1
10066# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10067 do
10068# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10069 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10070# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10071 if (ios2 /= 0) exit
10072# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10073 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
10074# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10075 yrows = yrows + 1
10076# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10077 else
10078# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10079 exit
10080# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10081 end if
10082# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10083 end do
10084# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10085 close (unit2)
10086# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10087
10088# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10089 ! Count total rows
10090# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10091 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10092# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10093 nrows = 0
10094# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10095 do
10096# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10097 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10098# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10099 if (ios2 /= 0) exit
10100# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10101 nrows = nrows + 1
10102# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10103 end do
10104# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10105 close (unit2)
10106# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10107
10108# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10109 xrows = nrows/yrows
10110# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10111#ifdef MFC_DEBUG
10112# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10113 block
10114# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10115 use iso_fortran_env, only: output_unit
10116# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10117
10118# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10119 print *, 'm_icpp_patches.fpp:707: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
10120# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10121
10122# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10123 call flush (output_unit)
10124# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10125 end block
10126# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10127#endif
10128# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10129 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
10130# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10131
10132# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10133
10134# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10135
10136# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10137
10138# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10139#if defined(MFC_OpenACC)
10140# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10141!$acc enter data create(x_coords, y_coords, stored_values)
10142# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10143#elif defined(MFC_OpenMP)
10144# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10145!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
10146# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10147#endif
10148# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10149 index_x = i
10150# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10151 index_y = j
10152# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10153
10154# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10155 ! Read all files
10156# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10157 do f = 1, max_files
10158# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10159 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10160# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10161 if (ios /= 0) then
10162# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10163 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10164# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10165 cycle
10166# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10167 end if
10168# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10169
10170# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10171 iter = 0
10172# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10173 do iix = 1, xrows
10174# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10175 do iiy = 1, yrows
10176# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10177 iter = iter + 1
10178# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10179 if (f == 1) then
10180# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10181 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
10182# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10183 else
10184# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10185 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
10186# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10187 end if
10188# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10189 if (ios /= 0) call s_mpi_abort("Error reading data")
10190# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10191 end do
10192# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10193 end do
10194# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10195 close (unit)
10196# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10197 end do
10198# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10199
10200# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10201 ! Calculate offsets
10202# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10203 x_step = x_cc(1) - x_cc(0)
10204# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10205 y_step = y_cc(1) - y_cc(0)
10206# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10207 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
10208# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10209 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
10210# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10211 global_offset_x = nint(abs(delta_x)/x_step)
10212# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10213 global_offset_y = nint(abs(delta_y)/y_step)
10214# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10215 end select
10216# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10217
10218# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10219 files_loaded = .true.
10220# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10221 end if
10222# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10223
10224# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10225 ! Data assignment
10226# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10227 select case (num_dims)
10228# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10229 case (1)
10230# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10231 idx = i + 1 + global_offset_x
10232# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10233 do f = 1, sys_size
10234# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10235 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10236# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10237 end do
10238# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10239 case (2)
10240# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10241 idx = i + 1 + global_offset_x - index_x
10242# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10243 do f = 1, sys_size - 1
10244# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10245 jump = merge(1, 0, f >= eqn_idx%mom%end)
10246# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10247 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10248# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10249 end do
10250# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10251 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
10252# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10253 case (3)
10254# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10255 idx = i + 1 + global_offset_x - index_x
10256# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10257 idy = j + 1 + global_offset_y - index_y
10258# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10259 do f = 1, sys_size - 1
10260# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10261 jump = merge(1, 0, f >= eqn_idx%mom%end)
10262# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10263 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10264# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10265 end do
10266# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10267 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
10268# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10269 end select
10270# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10271 case (380) ! Taylor-Green vortex
10272# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10273 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
10274# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10275 ! geometry 9
10276# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10277 mach = 0.1
10278# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10279 if (patch_id == 1) then
10280# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10281 q_prim_vf(eqn_idx%E)%sf(i, j, &
10282# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10283 & 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)
10284# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10285 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
10286# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10287 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
10288# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10289 end if
10290# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10291 case default
10292# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10293 call s_int_to_str(patch_id, istr)
10294# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10295 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10296# 707 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10297 end select
10298 end if
10299
10300 ! Updating the patch identities bookkeeping variable
10301 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10302 end if
10303 end do
10304 end do
10305 if (allocated(stored_values)) then
10306# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10307#ifdef MFC_DEBUG
10308# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10309 block
10310# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10311 use iso_fortran_env, only: output_unit
10312# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10313
10314# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10315 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(stored_values)'
10316# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10317
10318# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10319 call flush (output_unit)
10320# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10321 end block
10322# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10323#endif
10324# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10325
10326# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10327#if defined(MFC_OpenACC)
10328# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10329!$acc exit data delete(stored_values)
10330# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10331#elif defined(MFC_OpenMP)
10332# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10333!$omp target exit data map(release:stored_values)
10334# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10335#endif
10336# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10337 deallocate (stored_values)
10338# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10339#ifdef MFC_DEBUG
10340# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10341 block
10342# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10343 use iso_fortran_env, only: output_unit
10344# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10345
10346# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10347 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(x_coords)'
10348# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10349
10350# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10351 call flush (output_unit)
10352# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10353 end block
10354# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10355#endif
10356# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10357
10358# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10359#if defined(MFC_OpenACC)
10360# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10361!$acc exit data delete(x_coords)
10362# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10363#elif defined(MFC_OpenMP)
10364# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10365!$omp target exit data map(release:x_coords)
10366# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10367#endif
10368# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10369 deallocate (x_coords)
10370# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10371 end if
10372# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10373
10374# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10375 if (allocated(y_coords)) then
10376# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10377#ifdef MFC_DEBUG
10378# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10379 block
10380# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10381 use iso_fortran_env, only: output_unit
10382# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10383
10384# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10385 print *, 'm_icpp_patches.fpp:715: ', '@:DEALLOCATE(y_coords)'
10386# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10387
10388# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10389 call flush (output_unit)
10390# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10391 end block
10392# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10393#endif
10394# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10395
10396# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10397#if defined(MFC_OpenACC)
10398# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10399!$acc exit data delete(y_coords)
10400# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10401#elif defined(MFC_OpenMP)
10402# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10403!$omp target exit data map(release:y_coords)
10404# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10405#endif
10406# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10407 deallocate (y_coords)
10408# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10409 end if
10410
10411 end subroutine s_icpp_sweep_line
10412
10413 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
10414 !! Geometry of the patch is well-defined when its centroid are provided.
10415 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
10416
10417 integer, intent(in) :: patch_id
10418
10419#ifdef MFC_MIXED_PRECISION
10420 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10421#else
10422 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10423#endif
10424 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10425 integer :: i, j, k !< generic loop iterators
10426 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
10427 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
10428
10429 integer :: xRows, yRows, nRows, iix, iiy, max_files
10430# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10431 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10432# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10433 real(wp) :: x_len, x_step, y_len, y_step
10434# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10435 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10436# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10437 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
10438# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10439 real(wp) :: delta_x, delta_y
10440# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10441 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
10442# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10443 character(len=200) :: errmsg
10444# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10445 real(wp), allocatable :: stored_values(:,:,:)
10446# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10447 real(wp), allocatable :: x_coords(:), y_coords(:)
10448# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10449 logical :: files_loaded = .false.
10450# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10451 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10452# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10453 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
10454# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10455 character(len=20) :: file_num_str !< For storing the file number as a string
10456# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10457 character(len=20) :: zeros_part !< For the trailing zeros part
10458# 735 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10459 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
10460 ! Place any declaration of intermediate variables here
10461# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10462 real(wp) :: eps, eps_mhd, C_mhd
10463# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10464 real(wp) :: r, rmax, gam, umax, p0
10465# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10466 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
10467# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10468 real(wp) :: factor
10469# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10470 real(wp) :: r0, alpha, r2
10471# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10472 real(wp) :: sinA, cosA
10473# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10474 real(wp) :: r_sq
10475# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10476
10477# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10478 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
10479# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10480 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
10481# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10482 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
10483# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10484 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
10485# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10486 integer :: igq, jgq
10487# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10488
10489# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10490 ! # 291 - Shear/Thermal Layer Case
10491# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10492 real(wp) :: delta_shear, u_max, u_mean
10493# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10494 real(wp) :: T_wall, T_inf, P_atm, T_loc
10495# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10496 real(wp) :: delta_th, R_mix
10497# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10498 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
10499# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10500 real(wp) :: bottom_blend_u, bottom_blend_T
10501# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10502
10503# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10504 ! # 207
10505# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10506 real(wp) :: sigma, gauss1, gauss2
10507# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10508
10509# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10510 ! # 208
10511# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10512 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
10513# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10514
10515# 736 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10516 eps = 1.e-9_wp
10517
10518 pi_inf = pi_infs(1)
10519 gamma = gammas(1)
10520 lit_gamma = gs_min(1)
10521
10522 ! Transferring the patch's centroid and length information
10523 x_centroid = patch_icpp(patch_id)%x_centroid
10524 y_centroid = patch_icpp(patch_id)%y_centroid
10525 length_x = patch_icpp(patch_id)%length_x
10526 length_y = patch_icpp(patch_id)%length_y
10527
10528 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
10529 x_boundary%beg = x_centroid - 0.5_wp*length_x
10530 x_boundary%end = x_centroid + 0.5_wp*length_x
10531 y_boundary%beg = y_centroid - 0.5_wp*length_y
10532 y_boundary%end = y_centroid + 0.5_wp*length_y
10533
10534 ! Set eta=1 (no smoothing for this patch type)
10535 eta = 1._wp
10536 ! U0 is the characteristic velocity of the vortex
10537 u0 = patch_icpp(patch_id)%vel(1)
10538 ! L0 is the characteristic length of the vortex
10539 l0 = patch_icpp(patch_id)%vel(2)
10540 ! Assign patch vars if cell is covered and patch has write permission
10541 do j = 0, n
10542 do i = 0, m
10543 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, &
10544 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
10545 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
10546
10547
10548 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10549 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
10550# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10551 case (200) ! Two-fluid cubic interface
10552# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10553 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
10554# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10555 ! Volume Fractions
10556# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10557 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
10558# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10559 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
10560# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10561 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
10562# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10563 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
10564# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10565 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
10566# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10567 end if
10568# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10569 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
10570# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10571 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10572# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10573 rmax = 0.2_wp
10574# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10575
10576# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10577 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10578# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10579 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10580# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10581 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10582# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10583
10584# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10585 if (r < rmax) then
10586# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10587 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10588# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10589 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10590# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10591 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10592# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10593 else if (r < 2*rmax) then
10594# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10595 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10596# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10597 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10598# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10599 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
10600# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10601 else
10602# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10603 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10604# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10605 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10606# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10607 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
10608# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10609 end if
10610# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10611 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
10612# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10613 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10614# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10615 rmax = 0.2_wp
10616# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10617
10618# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10619 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10620# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10621 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10622# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10623 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10624# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10625
10626# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10627 if (r < rmax) then
10628# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10629 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10630# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10631 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10632# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10633 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10634# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10635 else if (r < 2*rmax) then
10636# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10637 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10638# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10639 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10640# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10641 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
10642# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10643 else
10644# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10645 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10646# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10647 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10648# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10649 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
10650# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10651 end if
10652# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10653
10654# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10655 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
10656# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10657 case (204) ! Rayleigh-Taylor instability
10658# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10659 rhoh = 3._wp
10660# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10661 rhol = 1._wp
10662# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10663 pref = 1.e5_wp
10664# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10665 pint = pref
10666# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10667 h = 0.7_wp
10668# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10669 lam = 0.2_wp
10670# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10671 wl = 2._wp*pi/lam
10672# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10673 amp = 0.05_wp/wl
10674# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10675
10676# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10677 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
10678# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10679
10680# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10681 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10682# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10683
10684# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10685 if (alph < eps) alph = eps
10686# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10687 if (alph > 1._wp - eps) alph = 1._wp - eps
10688# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10689
10690# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10691 if (y_cc(j) > inth) then
10692# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10693 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10694# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10695 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10696# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10697 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10698# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10699 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10700# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10701 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10702# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10703 else
10704# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10705 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10706# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10707 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10708# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10709 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10710# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10711 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10712# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10713 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10714# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10715 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
10716# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10717 end if
10718# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10719 case (205) ! 2D lung wave interaction problem
10720# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10721 h = 0.0_wp ! non dim origin y
10722# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10723 lam = 1.0_wp ! non dim lambda
10724# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10725 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
10726# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10727
10728# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10729 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
10730# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10731
10732# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10733 if (y_cc(j) > inth) then
10734# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10735 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10736# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10737 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10738# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10739 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10740# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10741 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10742# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10743 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10744# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10745 end if
10746# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10747 case (206) ! 2D lung wave interaction problem - horizontal domain
10748# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10749 h = 0.0_wp ! non dim origin y
10750# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10751 lam = 1.0_wp ! non dim lambda
10752# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10753 amp = patch_icpp(patch_id)%a(2)
10754# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10755
10756# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10757 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
10758# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10759
10760# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10761 if (x_cc(i) > intl) then ! this is the liquid
10762# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10763 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10764# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10765 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10766# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10767 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10768# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10769 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10770# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10771 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10772# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10773 end if
10774# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10775 case (207) ! Kelvin Helmholtz Instability
10776# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10777 sigma = 0.05_wp/sqrt(2.0_wp)
10778# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10779 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
10780# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10781 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
10782# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10783 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
10784# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10785 case (208) ! Richtmeyer Meshkov Instability
10786# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10787 lam = 1.0_wp
10788# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10789 eps = 1.0e-6_wp
10790# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10791 ei = 5.0_wp
10792# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10793 ! Smoothening function to smooth out sharp discontinuity in the interface
10794# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10795 if (x_cc(i) <= 0.7_wp*lam) then
10796# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10797 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
10798# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10799 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
10800# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10801 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
10802# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10803 alpha_sf6 = 1.0_wp - alpha_air
10804# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10805 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
10806# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10807 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
10808# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10809 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
10810# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10811 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
10812# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10813 end if
10814# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10815 case (250) ! MHD Orszag-Tang vortex
10816# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10817 ! 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),
10818# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10819 ! sin(4*pi*x)/sqrt(4*pi), 0)
10820# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10821
10822# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10823 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
10824# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10825 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
10826# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10827
10828# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10829 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
10830# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10831 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
10832# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10833 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
10834# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10835 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
10836# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10837 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
10838# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10839 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
10840# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10841 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
10842# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10843 ! Linear interpolation between r=0.08 and r=1.0
10844# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10845 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
10846# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10847 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
10848# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10849 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
10850# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10851 else
10852# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10853 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
10854# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10855 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
10856# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10857 end if
10858# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10859
10860# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10861 ! case 252 is for the 2D MHD Rotor problem
10862# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10863 case (252) ! 2D MHD Rotor Problem
10864# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10865 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
10866# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10867 !
10868# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10869 ! 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
10870# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10871 ! velocity w=20, giving v_tan=2 at r=0.1
10872# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10873
10874# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10875 ! Calculate distance squared from the center
10876# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10877 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10878# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10879
10880# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10881 ! inner radius of 0.1
10882# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10883 if (r_sq <= 0.1**2) then
10884# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10885 ! -- Inside the rotor -- Set density uniformly to 10
10886# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10887 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
10888# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10889
10890# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10891 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
10892# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10893 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10894# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10895 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10896# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10897
10898# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10899 ! taper width of 0.015
10900# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10901 else if (r_sq <= 0.115**2) then
10902# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10903 ! linearly smooth the function between r = 0.1 and 0.115
10904# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10905 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10906# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10907
10908# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10909 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10910# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10911 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10912# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10913 end if
10914# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10915 case (253) ! MHD Smooth Magnetic Vortex
10916# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10917 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
10918# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10919 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10920# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10921
10922# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10923 ! velocity
10924# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10925 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10926# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10927 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10928# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10929
10930# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10931 ! magnetic field
10932# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10933 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10934# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10935 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10936# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10937
10938# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10939 ! pressure
10940# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10941 q_prim_vf(eqn_idx%E)%sf(i, j, &
10942# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10943 & 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)
10944# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10945 case (260) ! Gaussian Divergence Pulse
10946# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10947 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
10948# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10949 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
10950# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10951 ! initialized to zero everywhere.
10952# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10953
10954# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10955 eps_mhd = patch_icpp(patch_id)%a(2)
10956# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10957 sigma = patch_icpp(patch_id)%a(3)
10958# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10959 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10960# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10961
10962# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10963 ! B-field
10964# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10965 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10966# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10967 case (261) ! Blob
10968# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10969 r0 = 1._wp/sqrt(8._wp)
10970# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10971 r2 = x_cc(i)**2 + y_cc(j)**2
10972# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10973 r = sqrt(r2)
10974# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10975 alpha = r/r0
10976# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10977 if (alpha < 1) then
10978# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10979 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
10980# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10981 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
10982# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10983 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
10984# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10985 ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp
10986# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10987 end if
10988# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10989 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
10990# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10991 ! rotate by \alpha = atan(2)
10992# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10993 alpha = atan(2._wp)
10994# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10995 cosa = cos(alpha)
10996# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10997 sina = sin(alpha)
10998# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10999 ! projection along shock normal
11000# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11001 r = x_cc(i)*cosa + y_cc(j)*sina
11002# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11003
11004# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11005 if (r <= 0.5_wp) then
11006# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11007 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
11008# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11009 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11010# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11011 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
11012# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11013 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
11014# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11015 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
11016# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11017 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
11018# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11019 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
11020# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11021 else
11022# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11023 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
11024# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11025 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11026# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11027 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
11028# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11029 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
11030# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11031 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
11032# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11033 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa - (5._wp/sqrt(4._wp*pi))*sina
11034# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11035 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina + (5._wp/sqrt(4._wp*pi))*cosa
11036# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11037 end if
11038# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11039 ! v^z and B^z remain zero by default
11040# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11041 case (270) ! 2D extrusion of 1D profile from external data
11042# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11043 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
11044# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11045 if (.not. files_loaded) then
11046# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11047 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11048# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11049 do f = 1, max_files
11050# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11051 write (file_num_str, '(I0)') f
11052# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11053 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11054# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11055 end do
11056# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11057
11058# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11059 ! Common file reading setup
11060# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11061 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11062# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11063 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11064# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11065
11066# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11067 select case (num_dims)
11068# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11069 case (1, 2) ! 1D and 2D cases are similar
11070# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11071 ! Count lines
11072# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11073 line_count = 0
11074# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11075 do
11076# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11077 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11078# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11079 if (ios2 /= 0) exit
11080# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11081 line_count = line_count + 1
11082# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11083 end do
11084# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11085 close (unit2)
11086# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11087
11088# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11089 xrows = line_count
11090# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11091 yrows = 1
11092# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11093 index_x = 0
11094# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11095 if (num_dims == 2) index_x = i
11096# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11097#ifdef MFC_DEBUG
11098# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11099 block
11100# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11101 use iso_fortran_env, only: output_unit
11102# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11103
11104# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11105 print *, 'm_icpp_patches.fpp:769: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11106# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11107
11108# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11109 call flush (output_unit)
11110# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11111 end block
11112# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11113#endif
11114# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11115 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11116# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11117
11118# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11119
11120# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11121
11122# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11123#if defined(MFC_OpenACC)
11124# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11125!$acc enter data create(x_coords, stored_values)
11126# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11127#elif defined(MFC_OpenMP)
11128# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11129!$omp target enter data map(always,alloc:x_coords, stored_values)
11130# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11131#endif
11132# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11133
11134# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11135 ! Read data from all files
11136# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11137 do f = 1, max_files
11138# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11139 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11140# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11141 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11142# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11143
11144# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11145 do iter = 1, xrows
11146# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11147 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11148# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11149 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11150# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11151 end do
11152# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11153 close (unit)
11154# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11155 end do
11156# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11157
11158# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11159 ! Calculate offsets
11160# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11161 domain_xstart = x_coords(1)
11162# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11163 x_step = x_cc(1) - x_cc(0)
11164# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11165 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)
11166# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11167 global_offset_x = nint(abs(delta_x)/x_step)
11168# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11169 case (3) ! 3D case - determine grid structure
11170# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11171 ! Find yRows by counting rows with same x
11172# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11173 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11174# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11175 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11176# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11177
11178# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11179 yrows = 1
11180# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11181 do
11182# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11183 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11184# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11185 if (ios2 /= 0) exit
11186# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11187 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11188# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11189 yrows = yrows + 1
11190# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11191 else
11192# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11193 exit
11194# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11195 end if
11196# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11197 end do
11198# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11199 close (unit2)
11200# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11201
11202# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11203 ! Count total rows
11204# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11205 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11206# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11207 nrows = 0
11208# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11209 do
11210# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11211 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11212# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11213 if (ios2 /= 0) exit
11214# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11215 nrows = nrows + 1
11216# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11217 end do
11218# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11219 close (unit2)
11220# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11221
11222# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11223 xrows = nrows/yrows
11224# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11225#ifdef MFC_DEBUG
11226# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11227 block
11228# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11229 use iso_fortran_env, only: output_unit
11230# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11231
11232# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11233 print *, 'm_icpp_patches.fpp:769: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11234# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11235
11236# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11237 call flush (output_unit)
11238# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11239 end block
11240# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11241#endif
11242# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11243 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11244# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11245
11246# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11247
11248# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11249
11250# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11251
11252# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11253#if defined(MFC_OpenACC)
11254# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11255!$acc enter data create(x_coords, y_coords, stored_values)
11256# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11257#elif defined(MFC_OpenMP)
11258# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11259!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11260# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11261#endif
11262# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11263 index_x = i
11264# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11265 index_y = j
11266# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11267
11268# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11269 ! Read all files
11270# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11271 do f = 1, max_files
11272# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11273 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11274# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11275 if (ios /= 0) then
11276# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11277 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11278# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11279 cycle
11280# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11281 end if
11282# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11283
11284# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11285 iter = 0
11286# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11287 do iix = 1, xrows
11288# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11289 do iiy = 1, yrows
11290# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11291 iter = iter + 1
11292# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11293 if (f == 1) then
11294# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11295 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11296# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11297 else
11298# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11299 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11300# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11301 end if
11302# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11303 if (ios /= 0) call s_mpi_abort("Error reading data")
11304# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11305 end do
11306# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11307 end do
11308# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11309 close (unit)
11310# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11311 end do
11312# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11313
11314# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11315 ! Calculate offsets
11316# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11317 x_step = x_cc(1) - x_cc(0)
11318# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11319 y_step = y_cc(1) - y_cc(0)
11320# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11321 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11322# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11323 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11324# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11325 global_offset_x = nint(abs(delta_x)/x_step)
11326# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11327 global_offset_y = nint(abs(delta_y)/y_step)
11328# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11329 end select
11330# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11331
11332# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11333 files_loaded = .true.
11334# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11335 end if
11336# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11337
11338# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11339 ! Data assignment
11340# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11341 select case (num_dims)
11342# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11343 case (1)
11344# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11345 idx = i + 1 + global_offset_x
11346# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11347 do f = 1, sys_size
11348# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11349 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11350# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11351 end do
11352# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11353 case (2)
11354# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11355 idx = i + 1 + global_offset_x - index_x
11356# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11357 do f = 1, sys_size - 1
11358# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11359 jump = merge(1, 0, f >= eqn_idx%mom%end)
11360# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11361 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11362# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11363 end do
11364# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11365 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11366# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11367 case (3)
11368# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11369 idx = i + 1 + global_offset_x - index_x
11370# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11371 idy = j + 1 + global_offset_y - index_y
11372# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11373 do f = 1, sys_size - 1
11374# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11375 jump = merge(1, 0, f >= eqn_idx%mom%end)
11376# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11377 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11378# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11379 end do
11380# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11381 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
11382# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11383 end select
11384# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11385 case (280) ! Isentropic vortex
11386# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11387 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
11388# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11389 ! geometry 2
11390# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11391 if (patch_id == 1) then
11392# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11393 q_prim_vf(eqn_idx%E)%sf(i, j, &
11394# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11395 & 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) &
11396# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11397 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
11398# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11399 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11400# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11401 & 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) &
11402# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11403 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
11404# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11405 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11406# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11407 & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
11408# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11409 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11410# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11411 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11412# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11413 & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) &
11414# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11415 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11416# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11417 end if
11418# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11419 case (281) ! Acoustic pulse
11420# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11421 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
11422# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11423 ! geometry 2
11424# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11425 if (patch_id == 2) then
11426# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11427 q_prim_vf(eqn_idx%E)%sf(i, j, &
11428# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11429 & 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))
11430# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11431 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11432# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11433 & 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))
11434# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11435 end if
11436# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11437 case (282) ! Zero-circulation vortex
11438# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11439 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
11440# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11441 ! geometry 2
11442# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11443 if (patch_id == 2) then
11444# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11445 q_prim_vf(eqn_idx%E)%sf(i, j, &
11446# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11447 & 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))
11448# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11449 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11450# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11451 & 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))
11452# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11453 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11454# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11455 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11456# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11457 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11458# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11459 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11460# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11461 end if
11462# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11463 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
11464# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11465 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
11466# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11467 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
11468# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11469 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
11470# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11471 ! patch_icpp(patch_id)%epsilon; defaults to 5.
11472# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11473 if (patch_id == 1) then
11474# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11475 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
11476# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11477 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
11478# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11479 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
11480# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11481 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
11482# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11483 do igq = 1, 3
11484# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11485 do jgq = 1, 3
11486# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11487 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
11488# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11489 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
11490# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11491 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
11492# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11493 t_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q))
11494# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11495 wq = gauss_w(igq)*gauss_w(jgq)
11496# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11497 rhoq = t_facq**1.4_wp
11498# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11499 pq = t_facq**2.4_wp
11500# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11501 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11502# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11503 & - r2q)
11504# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11505 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11506# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11507 & - r2q)
11508# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11509 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
11510# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11511 rho_avg = rho_avg + wq*rhoq
11512# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11513 rhou_avg = rhou_avg + wq*(rhoq*uq)
11514# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11515 rhov_avg = rhov_avg + wq*(rhoq*vq)
11516# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11517 e_avg = e_avg + wq*eq
11518# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11519 end do
11520# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11521 end do
11522# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11523 rho_avg = rho_avg*0.25_wp
11524# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11525 rhou_avg = rhou_avg*0.25_wp
11526# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11527 rhov_avg = rhov_avg*0.25_wp
11528# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11529 e_avg = e_avg*0.25_wp
11530# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11531 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
11532# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11533 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
11534# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11535 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
11536# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11537 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
11538# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11539 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = (e_avg - 0.5_wp*(rhou_avg**2 + rhov_avg**2)/rho_avg)*0.4_wp
11540# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11541 end if
11542# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11543 case (291) ! Isothermal Flat Plate
11544# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11545 t_inf = 1125.0_wp
11546# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11547 t_wall = 600.0_wp
11548# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11549 p_atm = 101325.0_wp
11550# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11551
11552# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11553 ! Boundary/Shear Layer thicknesses
11554# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11555 delta_th = 0.0003_wp ! Thermal BL thickness
11556# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11557 delta_shear = 8e-3_wp ! Velocity BL thickness
11558# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11559
11560# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11561 u_max = 50.0_wp ! Freestream Velocity (m/s)
11562# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11563
11564# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11565 mw_n2 = 28.0134e-3_wp
11566# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11567 mw_o2 = 31.999e-3_wp
11568# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11569 y_n2 = 0.767_wp
11570# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11571 y_o2 = 0.233_wp
11572# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11573 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
11574# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11575 bottom_blend_u = tanh(y_cc(j)/delta_shear)
11576# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11577 bottom_blend_t = tanh(y_cc(j)/delta_th)
11578# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11579 u_mean = u_max*bottom_blend_u
11580# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11581 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
11582# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11583 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
11584# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11585 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
11586# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11587 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11588# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11589 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
11590# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11591 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
11592# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11593 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
11594# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11595 case default
11596# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11597 if (proc_rank == 0) then
11598# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11599 call s_int_to_str(patch_id, istr)
11600# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11601 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
11602# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11603 end if
11604# 769 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11605 end select
11606 end if
11607
11608 ! Updating the patch identities bookkeeping variable
11609 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
11610
11611 ! Assign Parameters
11612 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
11613 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
11614 q_prim_vf(eqn_idx%E)%sf(i, j, &
11615 & 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, &
11616 & 0)*u0*u0)/16
11617 end if
11618 end do
11619 end do
11620 if (allocated(stored_values)) then
11621# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11622#ifdef MFC_DEBUG
11623# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11624 block
11625# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11626 use iso_fortran_env, only: output_unit
11627# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11628
11629# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11630 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(stored_values)'
11631# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11632
11633# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11634 call flush (output_unit)
11635# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11636 end block
11637# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11638#endif
11639# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11640
11641# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11642#if defined(MFC_OpenACC)
11643# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11644!$acc exit data delete(stored_values)
11645# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11646#elif defined(MFC_OpenMP)
11647# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11648!$omp target exit data map(release:stored_values)
11649# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11650#endif
11651# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11652 deallocate (stored_values)
11653# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11654#ifdef MFC_DEBUG
11655# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11656 block
11657# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11658 use iso_fortran_env, only: output_unit
11659# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11660
11661# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11662 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(x_coords)'
11663# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11664
11665# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11666 call flush (output_unit)
11667# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11668 end block
11669# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11670#endif
11671# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11672
11673# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11674#if defined(MFC_OpenACC)
11675# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11676!$acc exit data delete(x_coords)
11677# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678#elif defined(MFC_OpenMP)
11679# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680!$omp target exit data map(release:x_coords)
11681# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682#endif
11683# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 deallocate (x_coords)
11685# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686 end if
11687# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688
11689# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690 if (allocated(y_coords)) then
11691# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692#ifdef MFC_DEBUG
11693# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694 block
11695# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696 use iso_fortran_env, only: output_unit
11697# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698
11699# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700 print *, 'm_icpp_patches.fpp:784: ', '@:DEALLOCATE(y_coords)'
11701# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702
11703# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704 call flush (output_unit)
11705# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706 end block
11707# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708#endif
11709# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710
11711# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712#if defined(MFC_OpenACC)
11713# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714!$acc exit data delete(y_coords)
11715# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716#elif defined(MFC_OpenMP)
11717# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718!$omp target exit data map(release:y_coords)
11719# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720#endif
11721# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 deallocate (y_coords)
11723# 784 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11724 end if
11725
11726 end subroutine s_icpp_2d_taylorgreen_vortex
11727
11728 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
11729 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
11730
11731 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
11732
11733 ! Patch identifier
11734 integer, intent(in) :: patch_id
11735
11736#ifdef MFC_MIXED_PRECISION
11737 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11738#else
11739 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11740#endif
11741 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11742
11743 ! Generic loop iterators
11744 integer :: i, j, k
11745 ! Placeholders for the cell boundary values
11746 real(wp) :: pi_inf, gamma, lit_gamma
11747
11748 integer :: xRows, yRows, nRows, iix, iiy, max_files
11749# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11751# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752 real(wp) :: x_len, x_step, y_len, y_step
11753# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11755# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
11757# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758 real(wp) :: delta_x, delta_y
11759# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
11761# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762 character(len=200) :: errmsg
11763# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764 real(wp), allocatable :: stored_values(:,:,:)
11765# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766 real(wp), allocatable :: x_coords(:), y_coords(:)
11767# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 logical :: files_loaded = .false.
11769# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11771# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
11773# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 character(len=20) :: file_num_str !< For storing the file number as a string
11775# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 character(len=20) :: zeros_part !< For the trailing zeros part
11777# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11778 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
11779 ! Place any declaration of intermediate variables here
11780# 809 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11781 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
11782
11783 pi_inf = pi_infs(1)
11784 gamma = gammas(1)
11785 lit_gamma = gs_min(1)
11786
11787 ! Transferring the patch's centroid and length information
11788 x_centroid = patch_icpp(patch_id)%x_centroid
11789 length_x = patch_icpp(patch_id)%length_x
11790
11791 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
11792 x_boundary%beg = x_centroid - 0.5_wp*length_x
11793 x_boundary%end = x_centroid + 0.5_wp*length_x
11794
11795 ! Set eta=1 (no smoothing for this patch type)
11796 eta = 1._wp
11797
11798 ! Assign patch vars if cell is covered and patch has write permission
11799 do i = 0, m
11800 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, &
11801 & 0, 0))) then
11802 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
11803
11804
11805 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11806 select case (patch_icpp(patch_id)%hcid)
11807# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 case (150) ! 1D Smooth Alfven Case for MHD
11809# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 ! velocity
11811# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11813# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11815# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816
11817# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 ! magnetic field
11819# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11821# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11823# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
11825# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
11827# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 ! SDtoolbox)
11829# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830 if (.not. files_loaded) then
11831# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11833# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834 do f = 1, max_files
11835# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836 write (file_num_str, '(I0)') f
11837# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11839# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840 end do
11841# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842
11843# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844 ! Common file reading setup
11845# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11847# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11849# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850
11851# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852 select case (num_dims)
11853# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854 case (1, 2) ! 1D and 2D cases are similar
11855# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856 ! Count lines
11857# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 line_count = 0
11859# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860 do
11861# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11863# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864 if (ios2 /= 0) exit
11865# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 line_count = line_count + 1
11867# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868 end do
11869# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870 close (unit2)
11871# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872
11873# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874 xrows = line_count
11875# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876 yrows = 1
11877# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878 index_x = 0
11879# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880 if (num_dims == 2) index_x = i
11881# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882#ifdef MFC_DEBUG
11883# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884 block
11885# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886 use iso_fortran_env, only: output_unit
11887# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888
11889# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890 print *, 'm_icpp_patches.fpp:834: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11891# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892
11893# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 call flush (output_unit)
11895# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896 end block
11897# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898#endif
11899# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11901# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902
11903# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904
11905# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906
11907# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908#if defined(MFC_OpenACC)
11909# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910!$acc enter data create(x_coords, stored_values)
11911# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912#elif defined(MFC_OpenMP)
11913# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914!$omp target enter data map(always,alloc:x_coords, stored_values)
11915# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916#endif
11917# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918
11919# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 ! Read data from all files
11921# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922 do f = 1, max_files
11923# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11925# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11927# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928
11929# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930 do iter = 1, xrows
11931# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11933# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11935# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 end do
11937# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 close (unit)
11939# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940 end do
11941# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942
11943# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 ! Calculate offsets
11945# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 domain_xstart = x_coords(1)
11947# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948 x_step = x_cc(1) - x_cc(0)
11949# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950 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)
11951# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952 global_offset_x = nint(abs(delta_x)/x_step)
11953# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954 case (3) ! 3D case - determine grid structure
11955# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956 ! Find yRows by counting rows with same x
11957# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11959# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11961# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962
11963# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964 yrows = 1
11965# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 do
11967# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11969# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 if (ios2 /= 0) exit
11971# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11973# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 yrows = yrows + 1
11975# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 else
11977# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978 exit
11979# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980 end if
11981# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982 end do
11983# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11984 close (unit2)
11985# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11986
11987# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11988 ! Count total rows
11989# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11990 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11991# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11992 nrows = 0
11993# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11994 do
11995# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11996 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11997# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11998 if (ios2 /= 0) exit
11999# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12000 nrows = nrows + 1
12001# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12002 end do
12003# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12004 close (unit2)
12005# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12006
12007# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12008 xrows = nrows/yrows
12009# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12010#ifdef MFC_DEBUG
12011# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12012 block
12013# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12014 use iso_fortran_env, only: output_unit
12015# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12016
12017# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12018 print *, 'm_icpp_patches.fpp:834: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12019# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12020
12021# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12022 call flush (output_unit)
12023# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12024 end block
12025# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12026#endif
12027# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12028 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12029# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12030
12031# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12032
12033# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12034
12035# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12036
12037# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12038#if defined(MFC_OpenACC)
12039# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12040!$acc enter data create(x_coords, y_coords, stored_values)
12041# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12042#elif defined(MFC_OpenMP)
12043# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12044!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12045# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12046#endif
12047# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12048 index_x = i
12049# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12050 index_y = j
12051# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12052
12053# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12054 ! Read all files
12055# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12056 do f = 1, max_files
12057# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12058 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12059# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12060 if (ios /= 0) then
12061# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12062 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12063# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12064 cycle
12065# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12066 end if
12067# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12068
12069# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12070 iter = 0
12071# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12072 do iix = 1, xrows
12073# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12074 do iiy = 1, yrows
12075# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12076 iter = iter + 1
12077# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12078 if (f == 1) then
12079# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12080 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12081# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12082 else
12083# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12084 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12085# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12086 end if
12087# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12088 if (ios /= 0) call s_mpi_abort("Error reading data")
12089# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12090 end do
12091# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12092 end do
12093# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12094 close (unit)
12095# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12096 end do
12097# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12098
12099# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12100 ! Calculate offsets
12101# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12102 x_step = x_cc(1) - x_cc(0)
12103# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12104 y_step = y_cc(1) - y_cc(0)
12105# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12106 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12107# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12108 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12109# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12110 global_offset_x = nint(abs(delta_x)/x_step)
12111# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12112 global_offset_y = nint(abs(delta_y)/y_step)
12113# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12114 end select
12115# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12116
12117# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12118 files_loaded = .true.
12119# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12120 end if
12121# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12122
12123# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12124 ! Data assignment
12125# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12126 select case (num_dims)
12127# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12128 case (1)
12129# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12130 idx = i + 1 + global_offset_x
12131# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12132 do f = 1, sys_size
12133# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12134 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12135# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12136 end do
12137# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12138 case (2)
12139# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12140 idx = i + 1 + global_offset_x - index_x
12141# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12142 do f = 1, sys_size - 1
12143# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12144 jump = merge(1, 0, f >= eqn_idx%mom%end)
12145# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12146 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12147# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12148 end do
12149# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12150 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
12151# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12152 case (3)
12153# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12154 idx = i + 1 + global_offset_x - index_x
12155# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12156 idy = j + 1 + global_offset_y - index_y
12157# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12158 do f = 1, sys_size - 1
12159# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12160 jump = merge(1, 0, f >= eqn_idx%mom%end)
12161# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12162 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12163# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12164 end do
12165# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12166 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
12167# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12168 end select
12169# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12170 case (180) ! Shu-Osher problem
12171# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12172 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
12173# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12174 ! 0.2*sin(5*x)"
12175# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12176 if (patch_id == 2) then
12177# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12178 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
12179# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12180 end if
12181# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12182 case (181) ! Titarev-Torro problem
12183# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12184 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
12185# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12186 ! "1 + 0.1*sin(20*x*pi)"
12187# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12188 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
12189# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12190 case (182) ! Multi-component diffusion
12191# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12192 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
12193# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12194 x_mid_diffu = 0.05_wp/2.0_wp
12195# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12196 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
12197# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12198 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
12199# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12200 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12201# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12202 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
12203# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12204 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
12205# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12206
12207# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12208 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
12209# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12210 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
12211# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12212 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
12213# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12214 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
12215# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12216
12217# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12218 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
12219# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12220 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
12221# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12222 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
12223# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12224 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
12225# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12226
12227# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12228 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
12229# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12230
12231# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12232 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
12233# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12234
12235# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12236 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
12237# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12238 case(191) ! 1D Dual Isothermal case
12239# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12240 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
12241# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12242 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12243# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12244 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
12245# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12246
12247# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12248 if (x_cc(i) <= 0.025_wp) then
12249# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12250 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
12251# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12252 else
12253# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12254 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
12255# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12256 end if
12257# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12258
12259# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12260 molar_mass_inv = 1.0_wp/2.01588_wp
12261# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
12263# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12264 case default
12265# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12266 call s_int_to_str(patch_id, istr)
12267# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12268 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
12269# 834 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12270 end select
12271 end if
12272 end if
12273 end do
12274 if (allocated(stored_values)) then
12275# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12276#ifdef MFC_DEBUG
12277# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12278 block
12279# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12280 use iso_fortran_env, only: output_unit
12281# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12282
12283# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12284 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(stored_values)'
12285# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12286
12287# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12288 call flush (output_unit)
12289# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12290 end block
12291# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12292#endif
12293# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12294
12295# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12296#if defined(MFC_OpenACC)
12297# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12298!$acc exit data delete(stored_values)
12299# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12300#elif defined(MFC_OpenMP)
12301# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12302!$omp target exit data map(release:stored_values)
12303# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12304#endif
12305# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12306 deallocate (stored_values)
12307# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12308#ifdef MFC_DEBUG
12309# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12310 block
12311# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12312 use iso_fortran_env, only: output_unit
12313# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12314
12315# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12316 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(x_coords)'
12317# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12318
12319# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12320 call flush (output_unit)
12321# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12322 end block
12323# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12324#endif
12325# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12326
12327# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12328#if defined(MFC_OpenACC)
12329# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12330!$acc exit data delete(x_coords)
12331# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12332#elif defined(MFC_OpenMP)
12333# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12334!$omp target exit data map(release:x_coords)
12335# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12336#endif
12337# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12338 deallocate (x_coords)
12339# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12340 end if
12341# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12342
12343# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12344 if (allocated(y_coords)) then
12345# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12346#ifdef MFC_DEBUG
12347# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12348 block
12349# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12350 use iso_fortran_env, only: output_unit
12351# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12352
12353# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12354 print *, 'm_icpp_patches.fpp:838: ', '@:DEALLOCATE(y_coords)'
12355# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12356
12357# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12358 call flush (output_unit)
12359# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12360 end block
12361# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12362#endif
12363# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12364
12365# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12366#if defined(MFC_OpenACC)
12367# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12368!$acc exit data delete(y_coords)
12369# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12370#elif defined(MFC_OpenMP)
12371# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12372!$omp target exit data map(release:y_coords)
12373# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12374#endif
12375# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12376 deallocate (y_coords)
12377# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12378 end if
12379
12380 end subroutine s_icpp_1d_bubble_pulse
12381
12382 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
12383 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
12384 !! 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);
12385 !! coefficients are relative (dimensionless).
12386 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
12387
12388 integer, intent(in) :: patch_id
12389
12390#ifdef MFC_MIXED_PRECISION
12391 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12392#else
12393 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12394#endif
12395 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12396 real(wp) :: r, theta, R_boundary, sum_series
12397 integer :: i, j, nn
12398
12399 x_centroid = patch_icpp(patch_id)%x_centroid
12400 y_centroid = patch_icpp(patch_id)%y_centroid
12401 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12402 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12403 eta = 1._wp
12404
12405 do j = 0, n
12406 do i = 0, m
12407 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
12408 if (r < small_radius) then
12409 theta = 0._wp
12410 else
12411 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
12412 end if
12413 sum_series = 0._wp
12414 do nn = 1, max_2d_fourier_modes
12415 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
12416 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
12417 end do
12418 if (patch_icpp(patch_id)%modal_use_exp_form) then
12419 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
12420 else
12421 r_boundary = patch_icpp(patch_id)%radius + sum_series
12422 r_boundary = max(r_boundary, 0._wp)
12423 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
12424 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
12425 end if
12426 end if
12427 if (patch_icpp(patch_id)%smoothen) then
12428 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy)*(r_boundary - r))
12429 end if
12430 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
12431 & 0) == smooth_patch_id) then
12432 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
12433 end if
12434 end do
12435 end do
12436
12437 end subroutine s_icpp_2d_modal
12438
12439 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
12440 !! atan2(y,x) relative to centroid.
12441 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
12442
12443 integer, intent(in) :: patch_id
12444
12445#ifdef MFC_MIXED_PRECISION
12446 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12447#else
12448 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12449#endif
12450 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12451 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
12452 integer :: i, j, k, ll, mm
12453
12454 x_centroid = patch_icpp(patch_id)%x_centroid
12455 y_centroid = patch_icpp(patch_id)%y_centroid
12456 z_centroid = patch_icpp(patch_id)%z_centroid
12457 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12458 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12459 eta_local = 1._wp
12460
12461 do k = 0, p
12462 do j = 0, n
12463 do i = 0, m
12464 if (grid_geometry == 3) then
12465 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12466 dx_loc = x_cc(i) - x_centroid
12467 dy_loc = cart_y - y_centroid
12468 dz_loc = cart_z - z_centroid
12469 else
12470 dx_loc = x_cc(i) - x_centroid
12471 dy_loc = y_cc(j) - y_centroid
12472 dz_loc = z_cc(k) - z_centroid
12473 end if
12474 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
12475 if (r < small_radius) then
12476 theta = 0._wp
12477 phi = 0._wp
12478 else
12479 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
12480 phi = atan2(dy_loc, dx_loc)
12481 end if
12482 r_surface = patch_icpp(patch_id)%radius
12483 do ll = 0, max_sph_harm_degree
12484 do mm = -ll, ll
12485 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
12486 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
12487 end do
12488 end do
12489 if (patch_icpp(patch_id)%smoothen) then
12490 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy, dz)*(r_surface - r))
12491 end if
12492 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12493 & k) == smooth_patch_id) then
12494 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
12495 end if
12496 end do
12497 end do
12498 end do
12499
12500 end subroutine s_icpp_3d_spherical_harmonic
12501
12502 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
12503 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
12504 !! its boundary.
12505 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
12506
12507 integer, intent(in) :: patch_id
12508
12509#ifdef MFC_MIXED_PRECISION
12510 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12511#else
12512 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12513#endif
12514 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12515
12516 ! Generic loop iterators
12517 integer :: i, j, k
12518 real(wp) :: radius
12519
12520 integer :: xRows, yRows, nRows, iix, iiy, max_files
12521# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12522 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12523# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12524 real(wp) :: x_len, x_step, y_len, y_step
12525# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12526 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12527# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12528 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
12529# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12530 real(wp) :: delta_x, delta_y
12531# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12532 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
12533# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12534 character(len=200) :: errmsg
12535# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12536 real(wp), allocatable :: stored_values(:,:,:)
12537# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12538 real(wp), allocatable :: x_coords(:), y_coords(:)
12539# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12540 logical :: files_loaded = .false.
12541# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12542 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12543# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12544 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
12545# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12546 character(len=20) :: file_num_str !< For storing the file number as a string
12547# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 character(len=20) :: zeros_part !< For the trailing zeros part
12549# 980 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
12551 ! Place any declaration of intermediate variables here
12552# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12553 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12554# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12555 real(wp) :: eps
12556# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12557
12558# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12559 ! IGR Jets Arrays to stor position and radii of jets from input file
12560# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12561 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12562# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12563 ! Variables to describe initial condition of jet
12564# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12565 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12566# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12567 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
12568# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12569 real(wp), dimension(0:n,0:p) :: rcut_arr
12570# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12571 integer :: l, q, s !< Iterators for reading input files
12572# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12573 integer :: start, end !< Ints to keep track of position in file
12574# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12575 character(len=1000) :: line !< String to store line in file
12576# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12577 character(len=25) :: value !< String to store value in line
12578# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12579 integer :: NJet !< Number of jets
12580# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12581
12582# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12583 eps = 1e-9_wp
12584# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12585
12586# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12587 if (patch_icpp(patch_id)%hcid == 303) then
12588# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12589 eps_smooth = 3._wp
12590# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12591 open (unit=10, file="njet.txt", status="old", action="read")
12592# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12593 read (10, *) njet
12594# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12595 close (10)
12596# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12597
12598# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12599 allocate (y_th_arr(0:njet - 1))
12600# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12601 allocate (z_th_arr(0:njet - 1))
12602# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12603 allocate (r_th_arr(0:njet - 1))
12604# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12605
12606# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12607 open (unit=10, file="jets.csv", status="old", action="read")
12608# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12609 do q = 0, njet - 1
12610# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12611 read (10, '(A)') line ! Read a full line as a string
12612# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12613 start = 1
12614# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12615
12616# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12617 do l = 0, 2
12618# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12619 end = index(line(start:), ',') ! Find the next comma
12620# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12621 if (end == 0) then
12622# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12623 value = trim(adjustl(line(start:))) ! Last value in the line
12624# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12625 else
12626# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12627 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12628# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12629 start = start + end ! Move to next value
12630# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12631 end if
12632# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12633 if (l == 0) then
12634# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12635 read (value, *) y_th_arr(q) ! Convert string to numeric value
12636# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12637 else if (l == 1) then
12638# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12639 read (value, *) z_th_arr(q)
12640# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12641 else
12642# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12643 read (value, *) r_th_arr(q)
12644# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12645 end if
12646# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12647 end do
12648# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12649 end do
12650# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12651 close (10)
12652# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12653
12654# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12655 do q = 0, p
12656# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12657 do l = 0, n
12658# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12659 rcut = 0._wp
12660# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12661 do s = 0, njet - 1
12662# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12663 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12664# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12665 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12666# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12667 end do
12668# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12669 rcut_arr(l, q) = rcut
12670# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12671 end do
12672# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12673 end do
12674# 981 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12675 end if
12676
12677 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
12678
12679 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
12680 x_centroid = patch_icpp(patch_id)%x_centroid
12681 y_centroid = patch_icpp(patch_id)%y_centroid
12682 z_centroid = patch_icpp(patch_id)%z_centroid
12683 radius = patch_icpp(patch_id)%radius
12684 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12685 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12686
12687 ! Initialize eta=1; modified if smoothing is enabled
12688 eta = 1._wp
12689
12690 ! Assign patch vars if cell is covered and patch has write permission
12691 do k = 0, p
12692 do j = 0, n
12693 do i = 0, m
12694 if (grid_geometry == 3) then
12695 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12696 else
12697 cart_y = y_cc(j)
12698 cart_z = z_cc(k)
12699 end if
12700
12701 if (patch_icpp(patch_id)%smoothen) then
12702 eta = tanh(smooth_coeff/min(dx, dy, &
12703 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) &
12704 & - radius))*(-0.5_wp) + 0.5_wp
12705 end if
12706
12707 if ((f_is_inside_sphere(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, &
12708 & radius) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12709 & k) == smooth_patch_id) then
12710 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
12711
12712
12713 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12714 select case (patch_icpp(patch_id)%hcid)
12715# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12716 case (300) ! Rayleigh-Taylor instability
12717# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 rhoh = 3._wp
12719# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 rhol = 1._wp
12721# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722 pref = 1.e5_wp
12723# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 pint = pref
12725# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726 h = 0.7_wp
12727# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 lam = 0.2_wp
12729# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 wl = 2._wp*pi/lam
12731# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732 amp = 0.025_wp/wl
12733# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734
12735# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736 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
12737# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738
12739# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12741# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742
12743# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744 if (alph < eps) alph = eps
12745# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746 if (alph > 1._wp - eps) alph = 1._wp - eps
12747# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748
12749# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750 if (y_cc(j) > inth) then
12751# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12753# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12755# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12757# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12759# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12761# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762 else
12763# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12765# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12767# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12769# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12771# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12773# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12775# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776 end if
12777# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12779# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780 h = 0.0_wp
12781# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 lam = 1.0_wp
12783# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 amp = patch_icpp(patch_id)%a(2)
12785# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12787# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 if (x_cc(i) > inth) then
12789# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12791# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12793# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
12795# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12797# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12799# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800 end if
12801# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802 case (302) ! 3D Jet with IGR
12803# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804 ux_th = 10*sqrt(1.4*0.4)
12805# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 ux_am = 0.0*sqrt(1.4)
12807# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808 p_th = 2.0_wp
12809# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 p_am = 1.0_wp
12811# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812 rho_th = 1._wp
12813# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 rho_am = 1._wp
12815# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816 y_th = 0.0_wp
12817# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818 z_th = 0.0_wp
12819# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 r_th = 1._wp
12821# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822 eps_smooth = 1._wp
12823# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824 eps = 1e-6
12825# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826
12827# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12829# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830 rcut = f_cut_on(r - r_th, eps_smooth)
12831# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832 xcut = f_cut_on(x_cc(i), eps_smooth)
12833# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834
12835# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12837# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12839# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12841# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842
12843# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844 if (num_fluids == 1) then
12845# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12847# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848 else
12849# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12851# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12853# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
12855# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856 end if
12857# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858
12859# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12861# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862 case (303) ! 3D Multijet
12863# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864 eps_smooth = 3.0_wp
12865# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 ux_th = 10*sqrt(1.4*0.4)
12867# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868 ux_am = 2.5*sqrt(1.4*0.4)
12869# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870 p_th = 0.8_wp
12871# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872 p_am = 0.4_wp
12873# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874 rho_th = 1._wp
12875# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876 rho_am = 1._wp
12877# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878 eps = 1e-6
12879# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880
12881# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882 rcut = rcut_arr(j, k)
12883# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884 xcut = f_cut_on(x_cc(i), eps_smooth)
12885# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886
12887# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12889# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12891# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12893# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894
12895# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896 if (num_fluids == 1) then
12897# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12899# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900 else
12901# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12903# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12905# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
12907# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908 end if
12909# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910
12911# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12913# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 case (370) ! 3D extrusion of 2D profile from external data
12915# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12917# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918 if (.not. files_loaded) then
12919# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12921# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 do f = 1, max_files
12923# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 write (file_num_str, '(I0)') f
12925# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
12927# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 end do
12929# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930
12931# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932 ! Common file reading setup
12933# 1020 "/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# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12937# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938
12939# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940 select case (num_dims)
12941# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 case (1, 2) ! 1D and 2D cases are similar
12943# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 ! Count lines
12945# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946 line_count = 0
12947# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 do
12949# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12951# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952 if (ios2 /= 0) exit
12953# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954 line_count = line_count + 1
12955# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956 end do
12957# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958 close (unit2)
12959# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960
12961# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962 xrows = line_count
12963# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964 yrows = 1
12965# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966 index_x = 0
12967# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 if (num_dims == 2) index_x = i
12969# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970#ifdef MFC_DEBUG
12971# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972 block
12973# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974 use iso_fortran_env, only: output_unit
12975# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976
12977# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978 print *, 'm_icpp_patches.fpp:1020: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12979# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980
12981# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982 call flush (output_unit)
12983# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984 end block
12985# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986#endif
12987# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12989# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990
12991# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992
12993# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994
12995# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996#if defined(MFC_OpenACC)
12997# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998!$acc enter data create(x_coords, stored_values)
12999# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000#elif defined(MFC_OpenMP)
13001# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002!$omp target enter data map(always,alloc:x_coords, stored_values)
13003# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004#endif
13005# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006
13007# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008 ! Read data from all files
13009# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 do f = 1, max_files
13011# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13013# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13015# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016
13017# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018 do iter = 1, xrows
13019# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13021# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13023# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 end do
13025# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 close (unit)
13027# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 end do
13029# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030
13031# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032 ! Calculate offsets
13033# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034 domain_xstart = x_coords(1)
13035# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036 x_step = x_cc(1) - x_cc(0)
13037# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 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)
13039# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040 global_offset_x = nint(abs(delta_x)/x_step)
13041# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042 case (3) ! 3D case - determine grid structure
13043# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044 ! Find yRows by counting rows with same x
13045# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13046 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13047# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13048 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13049# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13050
13051# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13052 yrows = 1
13053# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13054 do
13055# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13056 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13057# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13058 if (ios2 /= 0) exit
13059# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13060 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13061# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13062 yrows = yrows + 1
13063# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13064 else
13065# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13066 exit
13067# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13068 end if
13069# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13070 end do
13071# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13072 close (unit2)
13073# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13074
13075# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13076 ! Count total rows
13077# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13078 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13079# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13080 nrows = 0
13081# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13082 do
13083# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13084 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13085# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13086 if (ios2 /= 0) exit
13087# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13088 nrows = nrows + 1
13089# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13090 end do
13091# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13092 close (unit2)
13093# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13094
13095# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13096 xrows = nrows/yrows
13097# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13098#ifdef MFC_DEBUG
13099# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13100 block
13101# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13102 use iso_fortran_env, only: output_unit
13103# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13104
13105# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13106 print *, 'm_icpp_patches.fpp:1020: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13107# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13108
13109# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13110 call flush (output_unit)
13111# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13112 end block
13113# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13114#endif
13115# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13116 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13117# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13118
13119# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13120
13121# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13122
13123# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13124
13125# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13126#if defined(MFC_OpenACC)
13127# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13128!$acc enter data create(x_coords, y_coords, stored_values)
13129# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13130#elif defined(MFC_OpenMP)
13131# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13132!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13133# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13134#endif
13135# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13136 index_x = i
13137# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13138 index_y = j
13139# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13140
13141# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13142 ! Read all files
13143# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13144 do f = 1, max_files
13145# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13146 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13147# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13148 if (ios /= 0) then
13149# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13150 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13151# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13152 cycle
13153# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13154 end if
13155# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13156
13157# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13158 iter = 0
13159# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13160 do iix = 1, xrows
13161# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13162 do iiy = 1, yrows
13163# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13164 iter = iter + 1
13165# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13166 if (f == 1) then
13167# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13168 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13169# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13170 else
13171# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13172 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13173# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13174 end if
13175# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13176 if (ios /= 0) call s_mpi_abort("Error reading data")
13177# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13178 end do
13179# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13180 end do
13181# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13182 close (unit)
13183# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13184 end do
13185# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13186
13187# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13188 ! Calculate offsets
13189# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13190 x_step = x_cc(1) - x_cc(0)
13191# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13192 y_step = y_cc(1) - y_cc(0)
13193# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13194 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13195# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13196 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13197# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13198 global_offset_x = nint(abs(delta_x)/x_step)
13199# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13200 global_offset_y = nint(abs(delta_y)/y_step)
13201# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13202 end select
13203# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13204
13205# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13206 files_loaded = .true.
13207# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13208 end if
13209# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13210
13211# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13212 ! Data assignment
13213# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13214 select case (num_dims)
13215# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13216 case (1)
13217# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13218 idx = i + 1 + global_offset_x
13219# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13220 do f = 1, sys_size
13221# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13222 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13223# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13224 end do
13225# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13226 case (2)
13227# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13228 idx = i + 1 + global_offset_x - index_x
13229# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13230 do f = 1, sys_size - 1
13231# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13232 jump = merge(1, 0, f >= eqn_idx%mom%end)
13233# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13234 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13235# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13236 end do
13237# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13238 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13239# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13240 case (3)
13241# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242 idx = i + 1 + global_offset_x - index_x
13243# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244 idy = j + 1 + global_offset_y - index_y
13245# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246 do f = 1, sys_size - 1
13247# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248 jump = merge(1, 0, f >= eqn_idx%mom%end)
13249# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13251# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 end do
13253# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13255# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13256 end select
13257# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13258 case (380) ! Taylor-Green vortex
13259# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13260 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
13261# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13262 ! geometry 9
13263# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13264 mach = 0.1
13265# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13266 if (patch_id == 1) then
13267# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13268 q_prim_vf(eqn_idx%E)%sf(i, j, &
13269# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13270 & 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)
13271# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13272 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
13273# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13274 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
13275# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13276 end if
13277# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13278 case default
13279# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13280 call s_int_to_str(patch_id, istr)
13281# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13282 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
13283# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13284 end select
13285 end if
13286 end if
13287 end do
13288 end do
13289 end do
13290 if (allocated(stored_values)) then
13291# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13292#ifdef MFC_DEBUG
13293# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13294 block
13295# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13296 use iso_fortran_env, only: output_unit
13297# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13298
13299# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13300 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(stored_values)'
13301# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13302
13303# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13304 call flush (output_unit)
13305# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13306 end block
13307# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308#endif
13309# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310
13311# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312#if defined(MFC_OpenACC)
13313# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314!$acc exit data delete(stored_values)
13315# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316#elif defined(MFC_OpenMP)
13317# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318!$omp target exit data map(release:stored_values)
13319# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320#endif
13321# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322 deallocate (stored_values)
13323# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324#ifdef MFC_DEBUG
13325# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326 block
13327# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328 use iso_fortran_env, only: output_unit
13329# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330
13331# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(x_coords)'
13333# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334
13335# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336 call flush (output_unit)
13337# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338 end block
13339# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340#endif
13341# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342
13343# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13344#if defined(MFC_OpenACC)
13345# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13346!$acc exit data delete(x_coords)
13347# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13348#elif defined(MFC_OpenMP)
13349# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13350!$omp target exit data map(release:x_coords)
13351# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13352#endif
13353# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13354 deallocate (x_coords)
13355# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13356 end if
13357# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13358
13359# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13360 if (allocated(y_coords)) then
13361# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13362#ifdef MFC_DEBUG
13363# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13364 block
13365# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13366 use iso_fortran_env, only: output_unit
13367# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13368
13369# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13370 print *, 'm_icpp_patches.fpp:1026: ', '@:DEALLOCATE(y_coords)'
13371# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13372
13373# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13374 call flush (output_unit)
13375# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13376 end block
13377# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13378#endif
13379# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13380
13381# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13382#if defined(MFC_OpenACC)
13383# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13384!$acc exit data delete(y_coords)
13385# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13386#elif defined(MFC_OpenMP)
13387# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13388!$omp target exit data map(release:y_coords)
13389# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13390#endif
13391# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13392 deallocate (y_coords)
13393# 1026 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13394 end if
13395
13396 end subroutine s_icpp_sphere
13397
13398 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
13399 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
13400 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
13401 !! allow for the smearing of its boundaries.
13402 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
13403
13404 integer, intent(in) :: patch_id
13405
13406#ifdef MFC_MIXED_PRECISION
13407 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13408#else
13409 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13410#endif
13411 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13412 integer :: i, j, k !< Generic loop iterators
13413
13414 integer :: xRows, yRows, nRows, iix, iiy, max_files
13415# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13416 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13417# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13418 real(wp) :: x_len, x_step, y_len, y_step
13419# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13420 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13421# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13422 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
13423# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13424 real(wp) :: delta_x, delta_y
13425# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
13427# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428 character(len=200) :: errmsg
13429# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 real(wp), allocatable :: stored_values(:,:,:)
13431# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13432 real(wp), allocatable :: x_coords(:), y_coords(:)
13433# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13434 logical :: files_loaded = .false.
13435# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13436 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13437# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13438 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
13439# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13440 character(len=20) :: file_num_str !< For storing the file number as a string
13441# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 character(len=20) :: zeros_part !< For the trailing zeros part
13443# 1046 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
13445 ! Place any declaration of intermediate variables here
13446# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13447 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13448# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13449 real(wp) :: eps
13450# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13451
13452# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13453 ! IGR Jets Arrays to stor position and radii of jets from input file
13454# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13455 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13456# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13457 ! Variables to describe initial condition of jet
13458# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13459 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13460# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13461 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
13462# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13463 real(wp), dimension(0:n,0:p) :: rcut_arr
13464# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13465 integer :: l, q, s !< Iterators for reading input files
13466# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13467 integer :: start, end !< Ints to keep track of position in file
13468# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13469 character(len=1000) :: line !< String to store line in file
13470# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13471 character(len=25) :: value !< String to store value in line
13472# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13473 integer :: NJet !< Number of jets
13474# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13475
13476# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13477 eps = 1e-9_wp
13478# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13479
13480# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13481 if (patch_icpp(patch_id)%hcid == 303) then
13482# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13483 eps_smooth = 3._wp
13484# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13485 open (unit=10, file="njet.txt", status="old", action="read")
13486# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13487 read (10, *) njet
13488# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13489 close (10)
13490# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13491
13492# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13493 allocate (y_th_arr(0:njet - 1))
13494# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13495 allocate (z_th_arr(0:njet - 1))
13496# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13497 allocate (r_th_arr(0:njet - 1))
13498# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13499
13500# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13501 open (unit=10, file="jets.csv", status="old", action="read")
13502# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13503 do q = 0, njet - 1
13504# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13505 read (10, '(A)') line ! Read a full line as a string
13506# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13507 start = 1
13508# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13509
13510# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13511 do l = 0, 2
13512# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13513 end = index(line(start:), ',') ! Find the next comma
13514# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13515 if (end == 0) then
13516# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13517 value = trim(adjustl(line(start:))) ! Last value in the line
13518# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13519 else
13520# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13521 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13522# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13523 start = start + end ! Move to next value
13524# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13525 end if
13526# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13527 if (l == 0) then
13528# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13529 read (value, *) y_th_arr(q) ! Convert string to numeric value
13530# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13531 else if (l == 1) then
13532# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13533 read (value, *) z_th_arr(q)
13534# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13535 else
13536# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13537 read (value, *) r_th_arr(q)
13538# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13539 end if
13540# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13541 end do
13542# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13543 end do
13544# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13545 close (10)
13546# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13547
13548# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13549 do q = 0, p
13550# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13551 do l = 0, n
13552# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13553 rcut = 0._wp
13554# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13555 do s = 0, njet - 1
13556# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13557 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13558# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13559 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13560# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13561 end do
13562# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13563 rcut_arr(l, q) = rcut
13564# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13565 end do
13566# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13567 end do
13568# 1047 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13569 end if
13570
13571 ! Transferring the cuboid's centroid and length information
13572 x_centroid = patch_icpp(patch_id)%x_centroid
13573 y_centroid = patch_icpp(patch_id)%y_centroid
13574 z_centroid = patch_icpp(patch_id)%z_centroid
13575 length_x = patch_icpp(patch_id)%length_x
13576 length_y = patch_icpp(patch_id)%length_y
13577 length_z = patch_icpp(patch_id)%length_z
13578
13579 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
13580 x_boundary%beg = x_centroid - 0.5_wp*length_x
13581 x_boundary%end = x_centroid + 0.5_wp*length_x
13582 y_boundary%beg = y_centroid - 0.5_wp*length_y
13583 y_boundary%end = y_centroid + 0.5_wp*length_y
13584 z_boundary%beg = z_centroid - 0.5_wp*length_z
13585 z_boundary%end = z_centroid + 0.5_wp*length_z
13586
13587 ! Set eta=1 (no smoothing for this patch type)
13588 eta = 1._wp
13589
13590 ! Assign patch vars if cell is covered and patch has write permission
13591 do k = 0, p
13592 do j = 0, n
13593 do i = 0, m
13594 if (grid_geometry == 3) then
13595 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
13596 else
13597 cart_y = y_cc(j)
13598 cart_z = z_cc(k)
13599 end if
13600
13601 if (f_is_inside_cuboid(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, [length_x, length_y, &
13602 & length_z])) then
13603 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
13604 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
13605
13606
13607 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13608 select case (patch_icpp(patch_id)%hcid)
13609# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13610 case (300) ! Rayleigh-Taylor instability
13611# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612 rhoh = 3._wp
13613# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614 rhol = 1._wp
13615# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 pref = 1.e5_wp
13617# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 pint = pref
13619# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 h = 0.7_wp
13621# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622 lam = 0.2_wp
13623# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 wl = 2._wp*pi/lam
13625# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626 amp = 0.025_wp/wl
13627# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628
13629# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630 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
13631# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632
13633# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13635# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636
13637# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638 if (alph < eps) alph = eps
13639# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640 if (alph > 1._wp - eps) alph = 1._wp - eps
13641# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642
13643# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644 if (y_cc(j) > inth) then
13645# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13647# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13649# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13651# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13653# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13655# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656 else
13657# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13659# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13661# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13663# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13665# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13667# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13669# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 end if
13671# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13673# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674 h = 0.0_wp
13675# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676 lam = 1.0_wp
13677# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 amp = patch_icpp(patch_id)%a(2)
13679# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13681# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682 if (x_cc(i) > inth) then
13683# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13685# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13687# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
13689# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13691# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13693# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694 end if
13695# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696 case (302) ! 3D Jet with IGR
13697# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698 ux_th = 10*sqrt(1.4*0.4)
13699# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700 ux_am = 0.0*sqrt(1.4)
13701# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702 p_th = 2.0_wp
13703# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704 p_am = 1.0_wp
13705# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 rho_th = 1._wp
13707# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 rho_am = 1._wp
13709# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710 y_th = 0.0_wp
13711# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712 z_th = 0.0_wp
13713# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714 r_th = 1._wp
13715# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716 eps_smooth = 1._wp
13717# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718 eps = 1e-6
13719# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720
13721# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13723# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724 rcut = f_cut_on(r - r_th, eps_smooth)
13725# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726 xcut = f_cut_on(x_cc(i), eps_smooth)
13727# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728
13729# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13731# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13733# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13735# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736
13737# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738 if (num_fluids == 1) then
13739# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13741# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 else
13743# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13745# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13747# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
13749# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750 end if
13751# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752
13753# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13755# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756 case (303) ! 3D Multijet
13757# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 eps_smooth = 3.0_wp
13759# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760 ux_th = 10*sqrt(1.4*0.4)
13761# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 ux_am = 2.5*sqrt(1.4*0.4)
13763# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 p_th = 0.8_wp
13765# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766 p_am = 0.4_wp
13767# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768 rho_th = 1._wp
13769# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770 rho_am = 1._wp
13771# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772 eps = 1e-6
13773# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774
13775# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776 rcut = rcut_arr(j, k)
13777# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778 xcut = f_cut_on(x_cc(i), eps_smooth)
13779# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780
13781# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13783# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13785# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13787# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788
13789# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790 if (num_fluids == 1) then
13791# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13793# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794 else
13795# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13797# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13799# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
13801# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802 end if
13803# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804
13805# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13807# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808 case (370) ! 3D extrusion of 2D profile from external data
13809# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13811# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 if (.not. files_loaded) then
13813# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13815# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 do f = 1, max_files
13817# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818 write (file_num_str, '(I0)') f
13819# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
13821# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822 end do
13823# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824
13825# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13826 ! Common file reading setup
13827# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13828 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13829# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13830 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13831# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13832
13833# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834 select case (num_dims)
13835# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836 case (1, 2) ! 1D and 2D cases are similar
13837# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 ! Count lines
13839# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840 line_count = 0
13841# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842 do
13843# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13845# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846 if (ios2 /= 0) exit
13847# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848 line_count = line_count + 1
13849# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850 end do
13851# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852 close (unit2)
13853# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854
13855# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856 xrows = line_count
13857# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858 yrows = 1
13859# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860 index_x = 0
13861# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862 if (num_dims == 2) index_x = i
13863# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864#ifdef MFC_DEBUG
13865# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866 block
13867# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868 use iso_fortran_env, only: output_unit
13869# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870
13871# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872 print *, 'm_icpp_patches.fpp:1086: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13873# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874
13875# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876 call flush (output_unit)
13877# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878 end block
13879# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880#endif
13881# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13883# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884
13885# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886
13887# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888
13889# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890#if defined(MFC_OpenACC)
13891# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892!$acc enter data create(x_coords, stored_values)
13893# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894#elif defined(MFC_OpenMP)
13895# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896!$omp target enter data map(always,alloc:x_coords, stored_values)
13897# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898#endif
13899# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900
13901# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902 ! Read data from all files
13903# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904 do f = 1, max_files
13905# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13907# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13909# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910
13911# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912 do iter = 1, xrows
13913# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13915# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13917# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 end do
13919# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920 close (unit)
13921# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922 end do
13923# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924
13925# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926 ! Calculate offsets
13927# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928 domain_xstart = x_coords(1)
13929# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930 x_step = x_cc(1) - x_cc(0)
13931# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932 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)
13933# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 global_offset_x = nint(abs(delta_x)/x_step)
13935# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936 case (3) ! 3D case - determine grid structure
13937# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938 ! Find yRows by counting rows with same x
13939# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13941# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13943# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944
13945# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946 yrows = 1
13947# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 do
13949# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13951# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952 if (ios2 /= 0) exit
13953# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13955# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956 yrows = yrows + 1
13957# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 else
13959# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 exit
13961# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962 end if
13963# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964 end do
13965# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966 close (unit2)
13967# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968
13969# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970 ! Count total rows
13971# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13973# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974 nrows = 0
13975# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 do
13977# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13979# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980 if (ios2 /= 0) exit
13981# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 nrows = nrows + 1
13983# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13984 end do
13985# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13986 close (unit2)
13987# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13988
13989# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13990 xrows = nrows/yrows
13991# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13992#ifdef MFC_DEBUG
13993# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13994 block
13995# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13996 use iso_fortran_env, only: output_unit
13997# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13998
13999# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14000 print *, 'm_icpp_patches.fpp:1086: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14001# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14002
14003# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14004 call flush (output_unit)
14005# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14006 end block
14007# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14008#endif
14009# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14010 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14011# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14012
14013# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14014
14015# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14016
14017# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14018
14019# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14020#if defined(MFC_OpenACC)
14021# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14022!$acc enter data create(x_coords, y_coords, stored_values)
14023# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14024#elif defined(MFC_OpenMP)
14025# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14026!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14027# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14028#endif
14029# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14030 index_x = i
14031# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14032 index_y = j
14033# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14034
14035# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14036 ! Read all files
14037# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14038 do f = 1, max_files
14039# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14040 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14041# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14042 if (ios /= 0) then
14043# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14044 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14045# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14046 cycle
14047# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14048 end if
14049# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14050
14051# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14052 iter = 0
14053# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14054 do iix = 1, xrows
14055# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14056 do iiy = 1, yrows
14057# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14058 iter = iter + 1
14059# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14060 if (f == 1) then
14061# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14062 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14063# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14064 else
14065# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14066 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14067# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14068 end if
14069# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14070 if (ios /= 0) call s_mpi_abort("Error reading data")
14071# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14072 end do
14073# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14074 end do
14075# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14076 close (unit)
14077# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14078 end do
14079# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14080
14081# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14082 ! Calculate offsets
14083# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14084 x_step = x_cc(1) - x_cc(0)
14085# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14086 y_step = y_cc(1) - y_cc(0)
14087# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14088 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14089# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14090 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14091# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14092 global_offset_x = nint(abs(delta_x)/x_step)
14093# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14094 global_offset_y = nint(abs(delta_y)/y_step)
14095# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14096 end select
14097# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14098
14099# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14100 files_loaded = .true.
14101# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14102 end if
14103# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14104
14105# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14106 ! Data assignment
14107# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14108 select case (num_dims)
14109# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14110 case (1)
14111# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14112 idx = i + 1 + global_offset_x
14113# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14114 do f = 1, sys_size
14115# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14116 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14117# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14118 end do
14119# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14120 case (2)
14121# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14122 idx = i + 1 + global_offset_x - index_x
14123# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14124 do f = 1, sys_size - 1
14125# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14126 jump = merge(1, 0, f >= eqn_idx%mom%end)
14127# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14128 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14129# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14130 end do
14131# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14132 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14133# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14134 case (3)
14135# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14136 idx = i + 1 + global_offset_x - index_x
14137# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14138 idy = j + 1 + global_offset_y - index_y
14139# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14140 do f = 1, sys_size - 1
14141# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14142 jump = merge(1, 0, f >= eqn_idx%mom%end)
14143# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14144 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14145# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14146 end do
14147# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14148 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
14149# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14150 end select
14151# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14152 case (380) ! Taylor-Green vortex
14153# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14154 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
14155# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14156 ! geometry 9
14157# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14158 mach = 0.1
14159# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14160 if (patch_id == 1) then
14161# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14162 q_prim_vf(eqn_idx%E)%sf(i, j, &
14163# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14164 & 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)
14165# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14166 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14167# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14168 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14169# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14170 end if
14171# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14172 case default
14173# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14174 call s_int_to_str(patch_id, istr)
14175# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14176 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14177# 1086 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14178 end select
14179 end if
14180
14181 ! Updating the patch identities bookkeeping variable
14182 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14183 end if
14184 end if
14185 end do
14186 end do
14187 end do
14188 if (allocated(stored_values)) then
14189# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14190#ifdef MFC_DEBUG
14191# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14192 block
14193# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14194 use iso_fortran_env, only: output_unit
14195# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14196
14197# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14198 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(stored_values)'
14199# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14200
14201# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14202 call flush (output_unit)
14203# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14204 end block
14205# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14206#endif
14207# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14208
14209# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14210#if defined(MFC_OpenACC)
14211# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14212!$acc exit data delete(stored_values)
14213# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14214#elif defined(MFC_OpenMP)
14215# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14216!$omp target exit data map(release:stored_values)
14217# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14218#endif
14219# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14220 deallocate (stored_values)
14221# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14222#ifdef MFC_DEBUG
14223# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14224 block
14225# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14226 use iso_fortran_env, only: output_unit
14227# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14228
14229# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14230 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(x_coords)'
14231# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14232
14233# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14234 call flush (output_unit)
14235# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14236 end block
14237# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14238#endif
14239# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14240
14241# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14242#if defined(MFC_OpenACC)
14243# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14244!$acc exit data delete(x_coords)
14245# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14246#elif defined(MFC_OpenMP)
14247# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14248!$omp target exit data map(release:x_coords)
14249# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14250#endif
14251# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14252 deallocate (x_coords)
14253# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14254 end if
14255# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14256
14257# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14258 if (allocated(y_coords)) then
14259# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14260#ifdef MFC_DEBUG
14261# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14262 block
14263# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14264 use iso_fortran_env, only: output_unit
14265# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14266
14267# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14268 print *, 'm_icpp_patches.fpp:1096: ', '@:DEALLOCATE(y_coords)'
14269# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14270
14271# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14272 call flush (output_unit)
14273# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14274 end block
14275# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14276#endif
14277# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14278
14279# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14280#if defined(MFC_OpenACC)
14281# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14282!$acc exit data delete(y_coords)
14283# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14284#elif defined(MFC_OpenMP)
14285# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14286!$omp target exit data map(release:y_coords)
14287# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14288#endif
14289# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14290 deallocate (y_coords)
14291# 1096 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14292 end if
14293
14294 end subroutine s_icpp_cuboid
14295
14296 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
14297 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
14298 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
14299 !! allow for the smoothing of its lateral boundary.
14300 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
14301
14302 integer, intent(in) :: patch_id
14303
14304#ifdef MFC_MIXED_PRECISION
14305 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14306#else
14307 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14308#endif
14309 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14310 integer :: i, j, k !< Generic loop iterators
14311 real(wp) :: radius
14312
14313 integer :: xRows, yRows, nRows, iix, iiy, max_files
14314# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14315 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14316# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317 real(wp) :: x_len, x_step, y_len, y_step
14318# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14320# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
14322# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323 real(wp) :: delta_x, delta_y
14324# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
14326# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14327 character(len=200) :: errmsg
14328# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14329 real(wp), allocatable :: stored_values(:,:,:)
14330# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14331 real(wp), allocatable :: x_coords(:), y_coords(:)
14332# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14333 logical :: files_loaded = .false.
14334# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14335 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14336# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14337 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
14338# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14339 character(len=20) :: file_num_str !< For storing the file number as a string
14340# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341 character(len=20) :: zeros_part !< For the trailing zeros part
14342# 1117 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
14344 ! Place any declaration of intermediate variables here
14345# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14346 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14347# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14348 real(wp) :: eps
14349# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14350
14351# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14352 ! IGR Jets Arrays to stor position and radii of jets from input file
14353# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14354 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14355# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14356 ! Variables to describe initial condition of jet
14357# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14358 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14359# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14360 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
14361# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14362 real(wp), dimension(0:n,0:p) :: rcut_arr
14363# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14364 integer :: l, q, s !< Iterators for reading input files
14365# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14366 integer :: start, end !< Ints to keep track of position in file
14367# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14368 character(len=1000) :: line !< String to store line in file
14369# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14370 character(len=25) :: value !< String to store value in line
14371# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14372 integer :: NJet !< Number of jets
14373# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14374
14375# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14376 eps = 1e-9_wp
14377# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14378
14379# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14380 if (patch_icpp(patch_id)%hcid == 303) then
14381# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14382 eps_smooth = 3._wp
14383# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14384 open (unit=10, file="njet.txt", status="old", action="read")
14385# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14386 read (10, *) njet
14387# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14388 close (10)
14389# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14390
14391# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14392 allocate (y_th_arr(0:njet - 1))
14393# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14394 allocate (z_th_arr(0:njet - 1))
14395# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14396 allocate (r_th_arr(0:njet - 1))
14397# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14398
14399# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14400 open (unit=10, file="jets.csv", status="old", action="read")
14401# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14402 do q = 0, njet - 1
14403# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14404 read (10, '(A)') line ! Read a full line as a string
14405# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14406 start = 1
14407# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14408
14409# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14410 do l = 0, 2
14411# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14412 end = index(line(start:), ',') ! Find the next comma
14413# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14414 if (end == 0) then
14415# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14416 value = trim(adjustl(line(start:))) ! Last value in the line
14417# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14418 else
14419# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14420 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14421# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14422 start = start + end ! Move to next value
14423# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14424 end if
14425# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14426 if (l == 0) then
14427# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14428 read (value, *) y_th_arr(q) ! Convert string to numeric value
14429# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14430 else if (l == 1) then
14431# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14432 read (value, *) z_th_arr(q)
14433# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14434 else
14435# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14436 read (value, *) r_th_arr(q)
14437# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14438 end if
14439# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14440 end do
14441# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14442 end do
14443# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14444 close (10)
14445# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14446
14447# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14448 do q = 0, p
14449# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14450 do l = 0, n
14451# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14452 rcut = 0._wp
14453# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14454 do s = 0, njet - 1
14455# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14456 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14457# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14458 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14459# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14460 end do
14461# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14462 rcut_arr(l, q) = rcut
14463# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14464 end do
14465# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14466 end do
14467# 1118 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14468 end if
14469
14470 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
14471 ! information
14472 x_centroid = patch_icpp(patch_id)%x_centroid
14473 y_centroid = patch_icpp(patch_id)%y_centroid
14474 z_centroid = patch_icpp(patch_id)%z_centroid
14475 length_x = patch_icpp(patch_id)%length_x
14476 length_y = patch_icpp(patch_id)%length_y
14477 length_z = patch_icpp(patch_id)%length_z
14478 radius = patch_icpp(patch_id)%radius
14479 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14480 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14481
14482 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
14483 x_boundary%beg = x_centroid - 0.5_wp*length_x
14484 x_boundary%end = x_centroid + 0.5_wp*length_x
14485 y_boundary%beg = y_centroid - 0.5_wp*length_y
14486 y_boundary%end = y_centroid + 0.5_wp*length_y
14487 z_boundary%beg = z_centroid - 0.5_wp*length_z
14488 z_boundary%end = z_centroid + 0.5_wp*length_z
14489
14490 ! Initialize eta=1; modified if smoothing is enabled
14491 eta = 1._wp
14492
14493 ! Assign patch vars if cell is covered and patch has write permission
14494 do k = 0, p
14495 do j = 0, n
14496 do i = 0, m
14497 if (grid_geometry == 3) then
14498 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
14499 else
14500 cart_y = y_cc(j)
14501 cart_z = z_cc(k)
14502 end if
14503
14504 if (patch_icpp(patch_id)%smoothen) then
14505 if (.not. f_is_default(length_x)) then
14506 eta = tanh(smooth_coeff/min(dy, &
14507 & dz)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14508 & + 0.5_wp
14509 else if (.not. f_is_default(length_y)) then
14510 eta = tanh(smooth_coeff/min(dx, &
14511 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14512 & + 0.5_wp
14513 else
14514 eta = tanh(smooth_coeff/min(dx, &
14515 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
14516 & + 0.5_wp
14517 end if
14518 end if
14519
14520 if (((.not. f_is_default(length_x) .and. f_is_inside_cylinder(cart_y - y_centroid, cart_z - z_centroid, &
14521 & x_cc(i) - x_centroid, radius, &
14522 & length_x)) .or. (.not. f_is_default(length_y) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
14523 & cart_z - z_centroid, cart_y - y_centroid, radius, &
14524 & length_y)) .or. (.not. f_is_default(length_z) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
14525 & cart_y - y_centroid, cart_z - z_centroid, radius, &
14526 & length_z)) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
14527 & k) == smooth_patch_id) then
14528 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
14529
14530
14531 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14532 select case (patch_icpp(patch_id)%hcid)
14533# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14534 case (300) ! Rayleigh-Taylor instability
14535# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14536 rhoh = 3._wp
14537# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14538 rhol = 1._wp
14539# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14540 pref = 1.e5_wp
14541# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14542 pint = pref
14543# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14544 h = 0.7_wp
14545# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14546 lam = 0.2_wp
14547# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14548 wl = 2._wp*pi/lam
14549# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14550 amp = 0.025_wp/wl
14551# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14552
14553# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14554 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
14555# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14556
14557# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14558 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14559# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14560
14561# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14562 if (alph < eps) alph = eps
14563# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14564 if (alph > 1._wp - eps) alph = 1._wp - eps
14565# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14566
14567# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14568 if (y_cc(j) > inth) then
14569# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14570 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14571# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14572 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14573# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14574 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14575# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14576 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14577# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14578 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14579# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14580 else
14581# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14582 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14583# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14584 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14585# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14586 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14587# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14588 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14589# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14590 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14591# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14592 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14593# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14594 end if
14595# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14596 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14597# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14598 h = 0.0_wp
14599# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14600 lam = 1.0_wp
14601# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14602 amp = patch_icpp(patch_id)%a(2)
14603# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14604 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14605# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14606 if (x_cc(i) > inth) then
14607# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14608 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14609# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14610 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14611# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14612 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
14613# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14614 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14615# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14616 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14617# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14618 end if
14619# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14620 case (302) ! 3D Jet with IGR
14621# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14622 ux_th = 10*sqrt(1.4*0.4)
14623# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14624 ux_am = 0.0*sqrt(1.4)
14625# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14626 p_th = 2.0_wp
14627# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14628 p_am = 1.0_wp
14629# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14630 rho_th = 1._wp
14631# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14632 rho_am = 1._wp
14633# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14634 y_th = 0.0_wp
14635# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14636 z_th = 0.0_wp
14637# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14638 r_th = 1._wp
14639# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14640 eps_smooth = 1._wp
14641# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14642 eps = 1e-6
14643# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14644
14645# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14646 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14647# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14648 rcut = f_cut_on(r - r_th, eps_smooth)
14649# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14650 xcut = f_cut_on(x_cc(i), eps_smooth)
14651# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14652
14653# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14654 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14655# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14656 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14657# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14658 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14659# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14660
14661# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14662 if (num_fluids == 1) then
14663# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14664 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14665# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14666 else
14667# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14668 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14669# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14670 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14671# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14672 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
14673# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14674 end if
14675# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14676
14677# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14678 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14679# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14680 case (303) ! 3D Multijet
14681# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14682 eps_smooth = 3.0_wp
14683# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14684 ux_th = 10*sqrt(1.4*0.4)
14685# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14686 ux_am = 2.5*sqrt(1.4*0.4)
14687# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14688 p_th = 0.8_wp
14689# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14690 p_am = 0.4_wp
14691# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14692 rho_th = 1._wp
14693# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14694 rho_am = 1._wp
14695# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14696 eps = 1e-6
14697# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14698
14699# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14700 rcut = rcut_arr(j, k)
14701# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14702 xcut = f_cut_on(x_cc(i), eps_smooth)
14703# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14704
14705# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14706 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14707# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14708 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14709# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14710 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14711# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14712
14713# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14714 if (num_fluids == 1) then
14715# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14716 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14717# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14718 else
14719# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14720 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14721# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14722 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14723# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14724 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
14725# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14726 end if
14727# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14728
14729# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14730 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14731# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14732 case (370) ! 3D extrusion of 2D profile from external data
14733# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14734 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14735# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14736 if (.not. files_loaded) then
14737# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14738 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14739# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14740 do f = 1, max_files
14741# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14742 write (file_num_str, '(I0)') f
14743# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14744 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
14745# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14746 end do
14747# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14748
14749# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14750 ! Common file reading setup
14751# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14752 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14753# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14754 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14755# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14756
14757# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14758 select case (num_dims)
14759# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14760 case (1, 2) ! 1D and 2D cases are similar
14761# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14762 ! Count lines
14763# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14764 line_count = 0
14765# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14766 do
14767# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14768 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14769# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14770 if (ios2 /= 0) exit
14771# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14772 line_count = line_count + 1
14773# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14774 end do
14775# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14776 close (unit2)
14777# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14778
14779# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14780 xrows = line_count
14781# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14782 yrows = 1
14783# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14784 index_x = 0
14785# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14786 if (num_dims == 2) index_x = i
14787# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14788#ifdef MFC_DEBUG
14789# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14790 block
14791# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14792 use iso_fortran_env, only: output_unit
14793# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14794
14795# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14796 print *, 'm_icpp_patches.fpp:1182: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14797# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14798
14799# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14800 call flush (output_unit)
14801# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14802 end block
14803# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14804#endif
14805# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14806 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14807# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14808
14809# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14810
14811# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14812
14813# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14814#if defined(MFC_OpenACC)
14815# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14816!$acc enter data create(x_coords, stored_values)
14817# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14818#elif defined(MFC_OpenMP)
14819# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14820!$omp target enter data map(always,alloc:x_coords, stored_values)
14821# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14822#endif
14823# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14824
14825# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14826 ! Read data from all files
14827# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14828 do f = 1, max_files
14829# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14830 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14831# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14832 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14833# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14834
14835# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14836 do iter = 1, xrows
14837# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14838 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14839# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14840 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14841# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14842 end do
14843# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14844 close (unit)
14845# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14846 end do
14847# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14848
14849# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14850 ! Calculate offsets
14851# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14852 domain_xstart = x_coords(1)
14853# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14854 x_step = x_cc(1) - x_cc(0)
14855# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14856 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)
14857# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14858 global_offset_x = nint(abs(delta_x)/x_step)
14859# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14860 case (3) ! 3D case - determine grid structure
14861# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14862 ! Find yRows by counting rows with same x
14863# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14864 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14865# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14866 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14867# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14868
14869# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14870 yrows = 1
14871# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14872 do
14873# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14874 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14875# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14876 if (ios2 /= 0) exit
14877# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14878 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
14879# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14880 yrows = yrows + 1
14881# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14882 else
14883# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14884 exit
14885# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14886 end if
14887# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14888 end do
14889# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14890 close (unit2)
14891# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14892
14893# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14894 ! Count total rows
14895# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14896 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14897# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14898 nrows = 0
14899# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14900 do
14901# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14902 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14903# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14904 if (ios2 /= 0) exit
14905# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14906 nrows = nrows + 1
14907# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908 end do
14909# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910 close (unit2)
14911# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912
14913# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914 xrows = nrows/yrows
14915# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916#ifdef MFC_DEBUG
14917# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918 block
14919# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920 use iso_fortran_env, only: output_unit
14921# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922
14923# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924 print *, 'm_icpp_patches.fpp:1182: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14925# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926
14927# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928 call flush (output_unit)
14929# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930 end block
14931# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932#endif
14933# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14935# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936
14937# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938
14939# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940
14941# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942
14943# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944#if defined(MFC_OpenACC)
14945# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946!$acc enter data create(x_coords, y_coords, stored_values)
14947# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948#elif defined(MFC_OpenMP)
14949# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14951# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952#endif
14953# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 index_x = i
14955# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956 index_y = j
14957# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958
14959# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960 ! Read all files
14961# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962 do f = 1, max_files
14963# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14965# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966 if (ios /= 0) then
14967# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14969# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970 cycle
14971# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972 end if
14973# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974
14975# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 iter = 0
14977# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978 do iix = 1, xrows
14979# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980 do iiy = 1, yrows
14981# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982 iter = iter + 1
14983# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984 if (f == 1) then
14985# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14987# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988 else
14989# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14991# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992 end if
14993# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994 if (ios /= 0) call s_mpi_abort("Error reading data")
14995# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996 end do
14997# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998 end do
14999# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000 close (unit)
15001# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002 end do
15003# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004
15005# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006 ! Calculate offsets
15007# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008 x_step = x_cc(1) - x_cc(0)
15009# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010 y_step = y_cc(1) - y_cc(0)
15011# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15012 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15013# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15014 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15015# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15016 global_offset_x = nint(abs(delta_x)/x_step)
15017# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15018 global_offset_y = nint(abs(delta_y)/y_step)
15019# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15020 end select
15021# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15022
15023# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15024 files_loaded = .true.
15025# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15026 end if
15027# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15028
15029# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15030 ! Data assignment
15031# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15032 select case (num_dims)
15033# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15034 case (1)
15035# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15036 idx = i + 1 + global_offset_x
15037# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15038 do f = 1, sys_size
15039# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15040 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15041# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15042 end do
15043# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15044 case (2)
15045# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15046 idx = i + 1 + global_offset_x - index_x
15047# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15048 do f = 1, sys_size - 1
15049# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15050 jump = merge(1, 0, f >= eqn_idx%mom%end)
15051# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15052 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15053# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15054 end do
15055# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15056 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15057# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15058 case (3)
15059# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15060 idx = i + 1 + global_offset_x - index_x
15061# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15062 idy = j + 1 + global_offset_y - index_y
15063# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15064 do f = 1, sys_size - 1
15065# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15066 jump = merge(1, 0, f >= eqn_idx%mom%end)
15067# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15068 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15069# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15070 end do
15071# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15072 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15073# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15074 end select
15075# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15076 case (380) ! Taylor-Green vortex
15077# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15078 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15079# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15080 ! geometry 9
15081# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15082 mach = 0.1
15083# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15084 if (patch_id == 1) then
15085# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15086 q_prim_vf(eqn_idx%E)%sf(i, j, &
15087# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15088 & 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)
15089# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15090 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
15091# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15092 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
15093# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15094 end if
15095# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15096 case default
15097# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15098 call s_int_to_str(patch_id, istr)
15099# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15100 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
15101# 1182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15102 end select
15103 end if
15104
15105 ! Updating the patch identities bookkeeping variable
15106 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15107 end if
15108 end do
15109 end do
15110 end do
15111 if (allocated(stored_values)) then
15112# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15113#ifdef MFC_DEBUG
15114# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15115 block
15116# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15117 use iso_fortran_env, only: output_unit
15118# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15119
15120# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15121 print *, 'm_icpp_patches.fpp:1191: ', '@:DEALLOCATE(stored_values)'
15122# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15123
15124# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15125 call flush (output_unit)
15126# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15127 end block
15128# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15129#endif
15130# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15131
15132# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15133#if defined(MFC_OpenACC)
15134# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15135!$acc exit data delete(stored_values)
15136# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15137#elif defined(MFC_OpenMP)
15138# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15139!$omp target exit data map(release:stored_values)
15140# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15141#endif
15142# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15143 deallocate (stored_values)
15144# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15145#ifdef MFC_DEBUG
15146# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15147 block
15148# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15149 use iso_fortran_env, only: output_unit
15150# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15151
15152# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15153 print *, 'm_icpp_patches.fpp:1191: ', '@:DEALLOCATE(x_coords)'
15154# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15155
15156# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15157 call flush (output_unit)
15158# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15159 end block
15160# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15161#endif
15162# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15163
15164# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15165#if defined(MFC_OpenACC)
15166# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15167!$acc exit data delete(x_coords)
15168# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15169#elif defined(MFC_OpenMP)
15170# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15171!$omp target exit data map(release:x_coords)
15172# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15173#endif
15174# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15175 deallocate (x_coords)
15176# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15177 end if
15178# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15179
15180# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15181 if (allocated(y_coords)) then
15182# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15183#ifdef MFC_DEBUG
15184# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15185 block
15186# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15187 use iso_fortran_env, only: output_unit
15188# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15189
15190# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15191 print *, 'm_icpp_patches.fpp:1191: ', '@:DEALLOCATE(y_coords)'
15192# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15193
15194# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15195 call flush (output_unit)
15196# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15197 end block
15198# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15199#endif
15200# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15201
15202# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15203#if defined(MFC_OpenACC)
15204# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15205!$acc exit data delete(y_coords)
15206# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15207#elif defined(MFC_OpenMP)
15208# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15209!$omp target exit data map(release:y_coords)
15210# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15211#endif
15212# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15213 deallocate (y_coords)
15214# 1191 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15215 end if
15216
15217 end subroutine s_icpp_cylinder
15218
15219 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
15220 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
15221 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
15222 !! the smoothing of its boundary.
15223 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
15224
15225 integer, intent(in) :: patch_id
15226
15227#ifdef MFC_MIXED_PRECISION
15228 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15229#else
15230 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15231#endif
15232 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15233 integer :: i, j, k !< Generic loop iterators
15234 real(wp) :: a, b, c, d
15235
15236 integer :: xRows, yRows, nRows, iix, iiy, max_files
15237# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15238 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
15239# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15240 real(wp) :: x_len, x_step, y_len, y_step
15241# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15242 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15243# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15244 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
15245# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15246 real(wp) :: delta_x, delta_y
15247# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15248 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
15249# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15250 character(len=200) :: errmsg
15251# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15252 real(wp), allocatable :: stored_values(:,:,:)
15253# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15254 real(wp), allocatable :: x_coords(:), y_coords(:)
15255# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15256 logical :: files_loaded = .false.
15257# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15258 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
15259# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15260 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
15261# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15262 character(len=20) :: file_num_str !< For storing the file number as a string
15263# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15264 character(len=20) :: zeros_part !< For the trailing zeros part
15265# 1212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15266 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
15267 ! Place any declaration of intermediate variables here
15268# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15269 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15270# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15271 real(wp) :: eps
15272# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15273
15274# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15275 ! IGR Jets Arrays to stor position and radii of jets from input file
15276# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15277 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15278# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15279 ! Variables to describe initial condition of jet
15280# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15281 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15282# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15283 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
15284# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15285 real(wp), dimension(0:n,0:p) :: rcut_arr
15286# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15287 integer :: l, q, s !< Iterators for reading input files
15288# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15289 integer :: start, end !< Ints to keep track of position in file
15290# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15291 character(len=1000) :: line !< String to store line in file
15292# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15293 character(len=25) :: value !< String to store value in line
15294# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15295 integer :: NJet !< Number of jets
15296# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15297
15298# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15299 eps = 1e-9_wp
15300# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15301
15302# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15303 if (patch_icpp(patch_id)%hcid == 303) then
15304# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15305 eps_smooth = 3._wp
15306# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15307 open (unit=10, file="njet.txt", status="old", action="read")
15308# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15309 read (10, *) njet
15310# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15311 close (10)
15312# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15313
15314# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15315 allocate (y_th_arr(0:njet - 1))
15316# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15317 allocate (z_th_arr(0:njet - 1))
15318# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15319 allocate (r_th_arr(0:njet - 1))
15320# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15321
15322# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15323 open (unit=10, file="jets.csv", status="old", action="read")
15324# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15325 do q = 0, njet - 1
15326# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15327 read (10, '(A)') line ! Read a full line as a string
15328# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15329 start = 1
15330# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15331
15332# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15333 do l = 0, 2
15334# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15335 end = index(line(start:), ',') ! Find the next comma
15336# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15337 if (end == 0) then
15338# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15339 value = trim(adjustl(line(start:))) ! Last value in the line
15340# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15341 else
15342# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15343 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15344# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15345 start = start + end ! Move to next value
15346# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15347 end if
15348# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15349 if (l == 0) then
15350# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15351 read (value, *) y_th_arr(q) ! Convert string to numeric value
15352# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15353 else if (l == 1) then
15354# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15355 read (value, *) z_th_arr(q)
15356# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15357 else
15358# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15359 read (value, *) r_th_arr(q)
15360# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15361 end if
15362# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15363 end do
15364# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15365 end do
15366# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367 close (10)
15368# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369
15370# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 do q = 0, p
15372# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373 do l = 0, n
15374# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 rcut = 0._wp
15376# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 do s = 0, njet - 1
15378# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15380# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15382# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 end do
15384# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385 rcut_arr(l, q) = rcut
15386# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15387 end do
15388# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15389 end do
15390# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15391 end if
15392
15393 ! Transferring the centroid information of the plane to be swept
15394 x_centroid = patch_icpp(patch_id)%x_centroid
15395 y_centroid = patch_icpp(patch_id)%y_centroid
15396 z_centroid = patch_icpp(patch_id)%z_centroid
15397 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15398 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15399
15400 ! Obtaining coefficients of the equation describing the sweep plane
15401 a = patch_icpp(patch_id)%normal(1)
15402 b = patch_icpp(patch_id)%normal(2)
15403 c = patch_icpp(patch_id)%normal(3)
15404 d = -a*x_centroid - b*y_centroid - c*z_centroid
15405
15406 ! Initialize eta=1; modified if smoothing is enabled
15407 eta = 1._wp
15408
15409 ! Assign patch vars if cell is covered and patch has write permission
15410 do k = 0, p
15411 do j = 0, n
15412 do i = 0, m
15413 if (grid_geometry == 3) then
15414 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
15415 else
15416 cart_y = y_cc(j)
15417 cart_z = z_cc(k)
15418 end if
15419
15420 if (patch_icpp(patch_id)%smoothen) then
15421 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, &
15422 & dz)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
15423 end if
15424
15425 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, &
15426 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
15427 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
15428
15429
15430 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15431 select case (patch_icpp(patch_id)%hcid)
15432# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15433 case (300) ! Rayleigh-Taylor instability
15434# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15435 rhoh = 3._wp
15436# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15437 rhol = 1._wp
15438# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15439 pref = 1.e5_wp
15440# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15441 pint = pref
15442# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15443 h = 0.7_wp
15444# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15445 lam = 0.2_wp
15446# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15447 wl = 2._wp*pi/lam
15448# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15449 amp = 0.025_wp/wl
15450# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15451
15452# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15453 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
15454# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15455
15456# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15457 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15458# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15459
15460# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15461 if (alph < eps) alph = eps
15462# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15463 if (alph > 1._wp - eps) alph = 1._wp - eps
15464# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15465
15466# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15467 if (y_cc(j) > inth) then
15468# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15469 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15470# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15471 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15472# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15473 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15474# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15475 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15476# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15477 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15478# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15479 else
15480# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15481 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15482# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15484# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15486# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15488# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15490# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15492# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493 end if
15494# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15496# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 h = 0.0_wp
15498# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499 lam = 1.0_wp
15500# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 amp = patch_icpp(patch_id)%a(2)
15502# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15504# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505 if (x_cc(i) > inth) then
15506# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15508# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15510# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
15512# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15514# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15516# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 end if
15518# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519 case (302) ! 3D Jet with IGR
15520# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 ux_th = 10*sqrt(1.4*0.4)
15522# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523 ux_am = 0.0*sqrt(1.4)
15524# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 p_th = 2.0_wp
15526# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527 p_am = 1.0_wp
15528# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 rho_th = 1._wp
15530# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 rho_am = 1._wp
15532# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 y_th = 0.0_wp
15534# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 z_th = 0.0_wp
15536# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537 r_th = 1._wp
15538# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 eps_smooth = 1._wp
15540# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541 eps = 1e-6
15542# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543
15544# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15546# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547 rcut = f_cut_on(r - r_th, eps_smooth)
15548# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 xcut = f_cut_on(x_cc(i), eps_smooth)
15550# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551
15552# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15554# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15556# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15557 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15558# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15559
15560# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15561 if (num_fluids == 1) then
15562# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15563 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15564# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15565 else
15566# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15567 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15568# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15569 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15570# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15571 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
15572# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15573 end if
15574# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15575
15576# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15577 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15578# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15579 case (303) ! 3D Multijet
15580# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15581 eps_smooth = 3.0_wp
15582# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15583 ux_th = 10*sqrt(1.4*0.4)
15584# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15585 ux_am = 2.5*sqrt(1.4*0.4)
15586# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15587 p_th = 0.8_wp
15588# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15589 p_am = 0.4_wp
15590# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15591 rho_th = 1._wp
15592# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 rho_am = 1._wp
15594# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15595 eps = 1e-6
15596# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15597
15598# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15599 rcut = rcut_arr(j, k)
15600# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15601 xcut = f_cut_on(x_cc(i), eps_smooth)
15602# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15603
15604# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15605 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15606# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15607 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15608# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15609 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15610# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15611
15612# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15613 if (num_fluids == 1) then
15614# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15615 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15616# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15617 else
15618# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15619 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15620# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15621 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15622# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15623 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))
15624# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15625 end if
15626# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15627
15628# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15629 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15630# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15631 case (370) ! 3D extrusion of 2D profile from external data
15632# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15633 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15634# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15635 if (.not. files_loaded) then
15636# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15637 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15638# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15639 do f = 1, max_files
15640# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15641 write (file_num_str, '(I0)') f
15642# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15643 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
15644# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15645 end do
15646# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15647
15648# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15649 ! Common file reading setup
15650# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15651 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15652# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15653 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
15654# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15655
15656# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15657 select case (num_dims)
15658# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15659 case (1, 2) ! 1D and 2D cases are similar
15660# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15661 ! Count lines
15662# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15663 line_count = 0
15664# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15665 do
15666# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15667 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15668# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15669 if (ios2 /= 0) exit
15670# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15671 line_count = line_count + 1
15672# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15673 end do
15674# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15675 close (unit2)
15676# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15677
15678# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15679 xrows = line_count
15680# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15681 yrows = 1
15682# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15683 index_x = 0
15684# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15685 if (num_dims == 2) index_x = i
15686# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15687#ifdef MFC_DEBUG
15688# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15689 block
15690# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15691 use iso_fortran_env, only: output_unit
15692# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15693
15694# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15695 print *, 'm_icpp_patches.fpp:1253: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15696# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15697
15698# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15699 call flush (output_unit)
15700# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15701 end block
15702# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15703#endif
15704# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15705 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15706# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15707
15708# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15709
15710# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15711
15712# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15713#if defined(MFC_OpenACC)
15714# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15715!$acc enter data create(x_coords, stored_values)
15716# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15717#elif defined(MFC_OpenMP)
15718# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15719!$omp target enter data map(always,alloc:x_coords, stored_values)
15720# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15721#endif
15722# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15723
15724# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15725 ! Read data from all files
15726# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15727 do f = 1, max_files
15728# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15729 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15730# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15731 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15732# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15733
15734# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15735 do iter = 1, xrows
15736# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15737 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15738# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15739 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
15740# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15741 end do
15742# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15743 close (unit)
15744# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15745 end do
15746# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15747
15748# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15749 ! Calculate offsets
15750# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15751 domain_xstart = x_coords(1)
15752# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15753 x_step = x_cc(1) - x_cc(0)
15754# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15755 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)
15756# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15757 global_offset_x = nint(abs(delta_x)/x_step)
15758# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15759 case (3) ! 3D case - determine grid structure
15760# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15761 ! Find yRows by counting rows with same x
15762# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15763 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15764# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15765 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15766# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15767
15768# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15769 yrows = 1
15770# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15771 do
15772# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15773 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15774# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15775 if (ios2 /= 0) exit
15776# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15777 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
15778# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15779 yrows = yrows + 1
15780# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15781 else
15782# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15783 exit
15784# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15785 end if
15786# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15787 end do
15788# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15789 close (unit2)
15790# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15791
15792# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15793 ! Count total rows
15794# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15795 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15796# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15797 nrows = 0
15798# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15799 do
15800# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15801 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15802# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15803 if (ios2 /= 0) exit
15804# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15805 nrows = nrows + 1
15806# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15807 end do
15808# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15809 close (unit2)
15810# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15811
15812# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15813 xrows = nrows/yrows
15814# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15815#ifdef MFC_DEBUG
15816# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15817 block
15818# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15819 use iso_fortran_env, only: output_unit
15820# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15821
15822# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15823 print *, 'm_icpp_patches.fpp:1253: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
15824# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15825
15826# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15827 call flush (output_unit)
15828# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15829 end block
15830# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15831#endif
15832# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15833 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
15834# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15835
15836# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15837
15838# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15839
15840# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15841
15842# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15843#if defined(MFC_OpenACC)
15844# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15845!$acc enter data create(x_coords, y_coords, stored_values)
15846# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15847#elif defined(MFC_OpenMP)
15848# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15849!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
15850# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15851#endif
15852# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15853 index_x = i
15854# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15855 index_y = j
15856# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15857
15858# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15859 ! Read all files
15860# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15861 do f = 1, max_files
15862# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15863 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15864# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15865 if (ios /= 0) then
15866# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15867 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15868# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15869 cycle
15870# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15871 end if
15872# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15873
15874# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15875 iter = 0
15876# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15877 do iix = 1, xrows
15878# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15879 do iiy = 1, yrows
15880# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15881 iter = iter + 1
15882# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15883 if (f == 1) then
15884# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15885 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15886# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15887 else
15888# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15889 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15890# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15891 end if
15892# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15893 if (ios /= 0) call s_mpi_abort("Error reading data")
15894# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15895 end do
15896# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15897 end do
15898# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15899 close (unit)
15900# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15901 end do
15902# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15903
15904# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15905 ! Calculate offsets
15906# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15907 x_step = x_cc(1) - x_cc(0)
15908# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15909 y_step = y_cc(1) - y_cc(0)
15910# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15911 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15912# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15913 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15914# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15915 global_offset_x = nint(abs(delta_x)/x_step)
15916# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15917 global_offset_y = nint(abs(delta_y)/y_step)
15918# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15919 end select
15920# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15921
15922# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15923 files_loaded = .true.
15924# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15925 end if
15926# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15927
15928# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15929 ! Data assignment
15930# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15931 select case (num_dims)
15932# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15933 case (1)
15934# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15935 idx = i + 1 + global_offset_x
15936# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15937 do f = 1, sys_size
15938# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15939 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15940# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15941 end do
15942# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15943 case (2)
15944# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15945 idx = i + 1 + global_offset_x - index_x
15946# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15947 do f = 1, sys_size - 1
15948# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15949 jump = merge(1, 0, f >= eqn_idx%mom%end)
15950# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15951 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15952# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15953 end do
15954# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15955 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15956# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15957 case (3)
15958# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15959 idx = i + 1 + global_offset_x - index_x
15960# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15961 idy = j + 1 + global_offset_y - index_y
15962# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15963 do f = 1, sys_size - 1
15964# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15965 jump = merge(1, 0, f >= eqn_idx%mom%end)
15966# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15967 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15968# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15969 end do
15970# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15971 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15972# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15973 end select
15974# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15975 case (380) ! Taylor-Green vortex
15976# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15977 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15978# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15979 ! geometry 9
15980# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15981 mach = 0.1
15982# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15983 if (patch_id == 1) then
15984# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15985 q_prim_vf(eqn_idx%E)%sf(i, j, &
15986# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15987 & 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)
15988# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15989 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
15990# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15991 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
15992# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15993 end if
15994# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15995 case default
15996# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15997 call s_int_to_str(patch_id, istr)
15998# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15999 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
16000# 1253 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16001 end select
16002 end if
16003
16004 ! Updating the patch identities bookkeeping variable
16005 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
16006 end if
16007 end do
16008 end do
16009 end do
16010 if (allocated(stored_values)) then
16011# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16012#ifdef MFC_DEBUG
16013# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16014 block
16015# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16016 use iso_fortran_env, only: output_unit
16017# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16018
16019# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16020 print *, 'm_icpp_patches.fpp:1262: ', '@:DEALLOCATE(stored_values)'
16021# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16022
16023# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16024 call flush (output_unit)
16025# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16026 end block
16027# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16028#endif
16029# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16030
16031# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16032#if defined(MFC_OpenACC)
16033# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16034!$acc exit data delete(stored_values)
16035# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16036#elif defined(MFC_OpenMP)
16037# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16038!$omp target exit data map(release:stored_values)
16039# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16040#endif
16041# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16042 deallocate (stored_values)
16043# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16044#ifdef MFC_DEBUG
16045# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16046 block
16047# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16048 use iso_fortran_env, only: output_unit
16049# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16050
16051# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16052 print *, 'm_icpp_patches.fpp:1262: ', '@:DEALLOCATE(x_coords)'
16053# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16054
16055# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16056 call flush (output_unit)
16057# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16058 end block
16059# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16060#endif
16061# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16062
16063# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16064#if defined(MFC_OpenACC)
16065# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16066!$acc exit data delete(x_coords)
16067# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16068#elif defined(MFC_OpenMP)
16069# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16070!$omp target exit data map(release:x_coords)
16071# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16072#endif
16073# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16074 deallocate (x_coords)
16075# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16076 end if
16077# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16078
16079# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16080 if (allocated(y_coords)) then
16081# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16082#ifdef MFC_DEBUG
16083# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16084 block
16085# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16086 use iso_fortran_env, only: output_unit
16087# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16088
16089# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16090 print *, 'm_icpp_patches.fpp:1262: ', '@:DEALLOCATE(y_coords)'
16091# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16092
16093# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16094 call flush (output_unit)
16095# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16096 end block
16097# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16098#endif
16099# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16100
16101# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16102#if defined(MFC_OpenACC)
16103# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16104!$acc exit data delete(y_coords)
16105# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16106#elif defined(MFC_OpenMP)
16107# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16108!$omp target exit data map(release:y_coords)
16109# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16110#endif
16111# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16112 deallocate (y_coords)
16113# 1262 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16114 end if
16115
16116 end subroutine s_icpp_sweep_plane
16117
16118 !> The STL patch is a 2/3D geometry that is imported from an STL file.
16119 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
16120
16121 integer, intent(in) :: patch_id
16122
16123#ifdef MFC_MIXED_PRECISION
16124 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16125#else
16126 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16127#endif
16128 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16129 integer :: i, j, k !< loop iterators
16130 integer :: model_id !< Index into the preloading stl_models(:)
16131 real(wp) :: threshold !< Inside/outside cutoff for this model
16132 real(wp), dimension(1:3) :: point !< Cell-center query point
16133 logical :: in_box !< Whether the cell center lies in the model's bounding box
16134
16135 model_id = patch_icpp(patch_id)%model_id
16136 threshold = stl_models(model_id)%model_threshold
16137
16138 do i = 0, m; do j = 0, n; do k = 0, p
16139 point = (/x_cc(i), y_cc(j), 0._wp/)
16140 if (p > 0) point(3) = z_cc(k)
16141 if (grid_geometry == 3) point = f_convert_cyl_to_cart(point)
16142
16143 ! Run the winding test only on cells whose Cartesian point lies inside the bounding box, else skip the calculation
16144 in_box = point(1) >= stl_bounding_boxes(model_id, 1, 1) .and. point(1) <= stl_bounding_boxes(model_id, 1, &
16145 & 3) .and. point(2) >= stl_bounding_boxes(model_id, 2, &
16146 & 1) .and. point(2) <= stl_bounding_boxes(model_id, 2, 3)
16147 if (p > 0 .or. grid_geometry == 3) then
16148 in_box = in_box .and. point(3) >= stl_bounding_boxes(model_id, 3, &
16149 & 1) .and. point(3) <= stl_bounding_boxes(model_id, 3, 3)
16150 end if
16151
16152 if (in_box) then
16153 eta = f_model_is_inside(gpu_ntrs(model_id), model_id, point)
16154 else
16155 eta = 0._wp
16156 end if
16157
16158 if (eta > threshold) then
16159 eta = 1._wp
16160 else if (.not. patch_icpp(patch_id)%smoothen) then
16161 eta = 0._wp
16162 end if
16163
16164 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
16165
16166
16167 end do; end do; end do
16168
16169 end subroutine s_icpp_model
16170
16171 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
16172 subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
16173
16174
16175# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16176#if MFC_OpenACC
16177# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16178!$acc routine seq
16179# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16180#elif MFC_OpenMP
16181# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16182
16183# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16184
16185# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16186!$omp declare target device_type(any)
16187# 1322 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16188#endif
16189
16190 real(wp), intent(in) :: cyl_y, cyl_z
16191
16192 cart_y = cyl_y*sin(cyl_z)
16193 cart_z = cyl_y*cos(cyl_z)
16194
16195 end subroutine s_convert_cylindrical_to_cartesian_coord
16196
16197 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
16198 function f_convert_cyl_to_cart(cyl) result(cart)
16199
16200
16201# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16202#if MFC_OpenACC
16203# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16204!$acc routine seq
16205# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16206#elif MFC_OpenMP
16207# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16208
16209# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16210
16211# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16212!$omp declare target device_type(any)
16213# 1334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16214#endif
16215
16216 real(wp), dimension(1:3), intent(in) :: cyl
16217 real(wp), dimension(1:3) :: cart
16218
16219 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
16220
16221 end function f_convert_cyl_to_cart
16222
16223 !> Archimedes spiral function
16224 elemental function f_r(myth, offset, a)
16225
16226
16227# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16228#if MFC_OpenACC
16229# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16230!$acc routine seq
16231# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16232#elif MFC_OpenMP
16233# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16234
16235# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16236
16237# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16238!$omp declare target device_type(any)
16239# 1346 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16240#endif
16241 real(wp), intent(in) :: myth, offset, a
16242 real(wp) :: b
16243 real(wp) :: f_r
16244
16245 ! r(th) = a + b*th
16246
16247 b = 2._wp*a/(2._wp*pi)
16248 f_r = a + b*myth + offset
16249
16250 end function f_r
16251
16252end module m_icpp_patches
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1078
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1078
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1078
m_assign_variables
Assigns initial primitive variables to computational cells based on patch geometry.
Definition m_assign_variables.fpp.f90:334
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:350
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_4eq
integer, parameter model_eqns_4eq
Definition m_constants.fpp.f90:136
m_constants::small_radius
real(wp), parameter small_radius
Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:19
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:23
m_constants::max_2d_fourier_modes
integer, parameter max_2d_fourier_modes
Max Fourier mode index for 2D modal patch (geometry 13).
Definition m_constants.fpp.f90:37
m_constants::max_sph_harm_degree
integer, parameter max_sph_harm_degree
Max degree L for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:38
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor Number of cells in the x-, y- and z-coordinate directions.
Definition m_global_parameters.fpp.f90:39
m_global_parameters::x_cc
real(wp), dimension(:), allocatable x_cc
Locations of cell-centers (cc) in x-, y- and z-directions, respectively.
Definition m_global_parameters.fpp.f90:47
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:323
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:340
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:334
m_icpp_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_icpp_patches.fpp.f90:393
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:6012
m_icpp_patches::cart_y
real(wp) cart_y
Definition m_icpp_patches.fpp.f90:416
m_icpp_patches::y_centroid
real(wp) y_centroid
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::length_x
real(wp) length_x
Definition m_icpp_patches.fpp.f90:412
m_icpp_patches::x_centroid
real(wp) x_centroid
Definition m_icpp_patches.fpp.f90:411
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:16199
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:2517
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:10416
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:13403
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:3817
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:12387
m_icpp_patches::cart_z
real(wp) cart_z
Definition m_icpp_patches.fpp.f90:416
m_icpp_patches::length_z
real(wp) length_z
Definition m_icpp_patches.fpp.f90:412
m_icpp_patches::istr
character(len=5) istr
string to store int to string result for error checking
Definition m_icpp_patches.fpp.f90:418
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:15224
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:8216
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:424
m_icpp_patches::smooth_coeff
real(wp) smooth_coeff
Smoothing coefficient (mirrors ic_patch_parameterssmooth_coeff).
Definition m_icpp_patches.fpp.f90:414
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:546
m_icpp_patches::y_boundary
type(bounds_info) y_boundary
Definition m_icpp_patches.fpp.f90:417
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:12506
m_icpp_patches::eta
real(wp) eta
Pseudo volume fraction for patch boundary smoothing.
Definition m_icpp_patches.fpp.f90:415
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:11730
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:12442
m_icpp_patches::length_y
real(wp) length_y
Definition m_icpp_patches.fpp.f90:412
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:16120
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:16173
m_icpp_patches::f_r
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
Definition m_icpp_patches.fpp.f90:16225
m_icpp_patches::z_centroid
real(wp) z_centroid
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::x_boundary
type(bounds_info) x_boundary
Definition m_icpp_patches.fpp.f90:417
m_icpp_patches::smooth_patch_id
integer smooth_patch_id
Definition m_icpp_patches.fpp.f90:413
m_icpp_patches::z_boundary
type(bounds_info) z_boundary
Patch boundary locations in x, y, z.
Definition m_icpp_patches.fpp.f90:417
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:9531
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:7315
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:14301
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:1206
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:5120
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:324
m_model::s_instantiate_stl_models
subroutine, public s_instantiate_stl_models()
Load, transform, and register STL/OBJ immersed-boundary models onto the simulation grid.
Definition m_model.fpp.f90:1266
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:334
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:877
m_patch_geometries
Contains helper functions specific to various patch gemoetries for determining if a grid cell lies in...
Definition m_patch_geometries.fpp.f90:324
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_variables_conversion::gammas
real(wp), dimension(:), allocatable, public gammas
Definition m_variables_conversion.fpp.f90:369
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:369
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:369
m_derived_types::bounds_info
Derived type adding beginning (beg) and end bounds info as attributes.
Definition m_derived_types.fpp.f90:538
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:337