MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_icpp_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_icpp_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp" 1
18!> Allocate memory and read initial condition data for IC extrusion.
19!>
20!> @details
21!> This macro handles the complete initialization process for IC extrusion by:
22!>
23!> **Memory Allocation:**
24!> - stored_values(xRows, yRows, sys_size) - stores primitive variable data from files
25!> - x_coords(nrows) - stores x-coordinates from input files
26!> - y_coords(nrows) - stores y-coordinates from input files (3D case only)
27!>
28!> **File Reading Operations:**
29!> - Reads primitive variable data from multiple files with pattern:
30!> `prim.<file_number>.00.<timestep>.dat` where timestep uses `zeros_default` padding
31!> - Files are read from directory specified by `init_dir` parameter
32!> - Supports 1D, 2D, and 3D computational domains
33!>
34!> **Grid Structure Detection:**
35!> - 1D/2D: Counts lines in first file to determine xRows
36!> - 3D: Analyzes coordinate patterns to determine xRows and yRows structure
37!>
38!> **MPI Domain Mapping:**
39!> - Calculates global_offset_x and global_offset_y for MPI subdomain positioning
40!> - Maps file coordinates to local computational grid coordinates
41!>
42!> **Data Assignment:**
43!> - Populates q_prim_vf primitive variable arrays with file data
44!> - Handles momentum component indexing with special treatment for eqn_idx%mom%end
45!> - Sets eqn_idx%mom%end component to zero for 2D/3D cases
46!>
47!> **State Management:**
48!> - Uses files_loaded flag to prevent redundant file operations
49!> - Preserves data across multiple macro calls within same simulation
50!>
51!> @note File pattern uses `zeros_default` parameter (default: "000000") for timestep padding
52!> @note Directory path is hardcoded in `init_dir` parameter - modify as needed
53!> @warning Aborts execution if file reading errors occur.
54
55# 56 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
56
57# 194 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 205 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
60# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
61# 1 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp" 1
62# 5 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
63
64# 74 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
65# 8 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
66# 1 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp" 1
67# 32 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 395 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
70# 9 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
71# 1 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp" 1
72# 66 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 186 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
75# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
76# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
77# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
78# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
79# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96
97# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98
99# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
100
101# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
102! New line at end of file is required for FYPP
103# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
104# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
105# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
106# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
107# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
108# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
110# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111
112# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
114# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115
116# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
117
118# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
119
120# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121
122# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123
124# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
125
126# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127
128# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
129! New line at end of file is required for FYPP
130# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
131
132# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
184
185# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
186
187# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
188
189# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
190
191# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
192
193# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
194
195# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
196
197# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
198
199# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
200
201# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
202
203# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
204
205# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
206
207# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
208! New line at end of file is required for FYPP
209# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
210# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
211# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
212# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
213# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
215# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
217
218# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
219# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
220# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
221
222# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
223
224# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
225
226# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
227
228# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
229
230# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
231
232# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
233
234# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
235! New line at end of file is required for FYPP
236# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
237
238# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273
274# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
275
276# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
277
278# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
279
280# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
281
282# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
283
284# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
285
286# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
287
288# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
289
290# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
291
292# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
293! New line at end of file is required for FYPP
294# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
295
296! GPU parallel region (scalar reductions, maxval/minval)
297# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298
299! GPU parallel loop over threads (most common GPU macro)
300# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301
302! Required closing for GPU_PARALLEL_LOOP
303# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
304
305! Mark routine for device compilation
306# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308! Declare device-resident data
309# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
310
311! Inner loop within a GPU parallel region
312# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314! Scoped GPU data region
315# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
316
317! Host code with device pointers (for MPI with GPU buffers)
318# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320! Allocate device memory (unscoped)
321# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
322
323! Free device memory
324# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326! Atomic operation on device
327# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
328
329! End atomic capture block
330# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332! Copy data between host and device
333# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334
335! Synchronization barrier
336# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
337
338! Import GPU library module (openacc or omp_lib)
339# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
340
341! Emit code only for AMD compiler
342# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
343
344! Emit code for non-Cray compilers
345# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
346
347! Emit code only for Cray compiler
348# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
349
350! Emit code for non-NVIDIA compilers
351# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
352
353# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
354# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
355! New line at end of file is required for FYPP
356# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
357
358# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
359
360! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
361! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
362! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
363# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
364
365! Allocate and create GPU device memory
366# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
367
368! Free GPU device memory and deallocate
369# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
370
371! Cray-specific GPU pointer setup for vector fields
372# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
373
374! Cray-specific GPU pointer setup for scalar fields
375# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
376
377! Cray-specific GPU pointer setup for acoustic source spatials
378# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
379
380# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
381
382# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
383! New line at end of file is required for FYPP
384# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
385
386!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
387module m_icpp_patches
388
389 use m_model ! Subroutine(s) related to STL files
390 use m_derived_types ! Definitions of the derived types
391 use m_global_parameters
392 use m_constants, only: max_2d_fourier_modes, max_sph_harm_degree, small_radius
393 use m_helper_basic
394 use m_helper
395 use m_mpi_common
396 use m_assign_variables
397 use m_mpi_common
398 use m_variables_conversion
399
400 implicit none
401
402 private; public :: s_apply_icpp_patches
403
404 real(wp) :: x_centroid, y_centroid, z_centroid
405 real(wp) :: length_x, length_y, length_z
406 integer :: smooth_patch_id
407 real(wp) :: smooth_coeff !< Smoothing coefficient (mirrors ic_patch_parameters%smooth_coeff)
408 real(wp) :: eta !< Pseudo volume fraction for patch boundary smoothing
409 real(wp) :: cart_y, cart_z
410 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
411 character(len=5) :: istr !< string to store int to string result for error checking
412
413contains
414
415 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
416 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
417
418 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
419
420#ifdef MFC_MIXED_PRECISION
421 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
422#else
423 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
424#endif
425 integer :: i
426
427 ! 3D Patch Geometries
428
429 if (p > 0) then
430 do i = 1, num_patches
431 if (proc_rank == 0) then
432 print *, 'Processing patch', i
433 end if
434
435 !> ICPP Patches
436 !> @{
437 ! Spherical patch
438 if (patch_icpp(i)%geometry == 8) then
439 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
440 ! Cuboidal patch
441 else if (patch_icpp(i)%geometry == 9) then
442 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
443 ! Cylindrical patch
444 else if (patch_icpp(i)%geometry == 10) then
445 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
446 ! Swept plane patch
447 else if (patch_icpp(i)%geometry == 11) then
448 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
449 ! Ellipsoidal patch
450 else if (patch_icpp(i)%geometry == 12) then
451 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
452 ! 3D spherical harmonic patch
453 else if (patch_icpp(i)%geometry == 14) then
454 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
455 ! 3D Modified circular patch
456 else if (patch_icpp(i)%geometry == 19) then
457 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
458 ! 3D STL patch
459 else if (patch_icpp(i)%geometry == 21) then
460 call s_icpp_model(i, patch_id_fp, q_prim_vf)
461 end if
462 end do
463 !> @}
464
465 ! 2D Patch Geometries
466 else if (n > 0) then
467 do i = 1, num_patches
468 if (proc_rank == 0) then
469 print *, 'Processing patch', i
470 end if
471
472 !> ICPP Patches
473 !> @{
474 ! Circular patch
475 if (patch_icpp(i)%geometry == 2) then
476 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
477 ! Rectangular patch
478 else if (patch_icpp(i)%geometry == 3) then
479 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
480 ! Swept line patch
481 else if (patch_icpp(i)%geometry == 4) then
482 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
483 ! Elliptical patch
484 else if (patch_icpp(i)%geometry == 5) then
485 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
486 ! Unimplemented patch (formerly isentropic vortex)
487 else if (patch_icpp(i)%geometry == 6) then
488 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
489 & // 'which no longer exists. See Examples. Exiting.')
490 ! 2D modal (Fourier) patch
491 else if (patch_icpp(i)%geometry == 13) then
492 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
493 ! Spiral patch
494 else if (patch_icpp(i)%geometry == 17) then
495 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
496 ! Modified circular patch
497 else if (patch_icpp(i)%geometry == 18) then
498 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
499 ! TaylorGreen vortex patch
500 else if (patch_icpp(i)%geometry == 20) then
501 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
502 ! STL patch
503 else if (patch_icpp(i)%geometry == 21) then
504 call s_icpp_model(i, patch_id_fp, q_prim_vf)
505 end if
506 !> @}
507 end do
508
509 ! 1D Patch Geometries
510 else
511 do i = 1, num_patches
512 if (proc_rank == 0) then
513 print *, 'Processing patch', i
514 end if
515
516 ! Line segment patch
517 if (patch_icpp(i)%geometry == 1) then
518 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
519 ! 1d analytical
520 else if (patch_icpp(i)%geometry == 16) then
521 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
522 end if
523 end do
524 end if
525
526 end subroutine s_apply_icpp_patches
527
528 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
529 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
530 !! patch DOES NOT allow for the smearing of its boundaries.
531 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
532
533 integer, intent(in) :: patch_id
534
535#ifdef MFC_MIXED_PRECISION
536 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
537#else
538 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
539#endif
540 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
541
542 ! Generic loop iterators
543 integer :: i, j, k
544
545 ! Placeholders for the cell boundary values
546 real(wp) :: pi_inf, gamma, lit_gamma
547
548 integer :: xRows, yRows, nRows, iix, iiy, max_files
549# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
550 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
551# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
552 real(wp) :: x_len, x_step, y_len, y_step
553# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
554 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
555# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
556 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
557# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
558 real(wp) :: delta_x, delta_y
559# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
560 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
561# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
562 character(len=200) :: errmsg
563# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
564 real(wp), allocatable :: stored_values(:,:,:)
565# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
566 real(wp), allocatable :: x_coords(:), y_coords(:)
567# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
568 logical :: files_loaded = .false.
569# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
570 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
571# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
572 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
573# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
574 character(len=20) :: file_num_str !< For storing the file number as a string
575# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
576 character(len=20) :: zeros_part !< For the trailing zeros part
577# 174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
578 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
579 ! Place any declaration of intermediate variables here
580# 175 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
581 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
582
583 pi_inf = pi_infs(1)
584 gamma = gammas(1)
585 lit_gamma = gs_min(1)
586 j = 0
587 k = 0
588
589 ! Transferring the line segment's centroid and length information
590 x_centroid = patch_icpp(patch_id)%x_centroid
591 length_x = patch_icpp(patch_id)%length_x
592
593 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
594 x_boundary%beg = x_centroid - 0.5_wp*length_x
595 x_boundary%end = x_centroid + 0.5_wp*length_x
596
597 ! Set eta=1 (no smoothing for this patch type)
598 eta = 1._wp
599
600 ! Assign patch vars if cell is covered and patch has write permission
601 do i = 0, m
602 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, &
603 & 0, 0))) then
604 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
605
606
607
608 ! check if this should load a hardcoded patch
609 if (patch_icpp(patch_id)%hcid /= dflt_int) then
610 select case (patch_icpp(patch_id)%hcid)
611# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
612 case (150) ! 1D Smooth Alfven Case for MHD
613# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
614 ! velocity
615# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
616 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
617# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
618 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
619# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
620
621# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
622 ! magnetic field
623# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
624 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
625# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
626 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
627# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
628 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
629# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
630 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
631# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
632 ! SDtoolbox)
633# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
634 if (.not. files_loaded) then
635# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
636 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
637# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
638 do f = 1, max_files
639# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
640 write (file_num_str, '(I0)') f
641# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
642 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
643# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
644 end do
645# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
646
647# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
648 ! Common file reading setup
649# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
650 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
651# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
652 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
653# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
654
655# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
656 select case (num_dims)
657# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
658 case (1, 2) ! 1D and 2D cases are similar
659# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
660 ! Count lines
661# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
662 line_count = 0
663# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
664 do
665# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
666 read (unit2, *, iostat=ios2) dummy_x, dummy_y
667# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
668 if (ios2 /= 0) exit
669# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
670 line_count = line_count + 1
671# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
672 end do
673# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
674 close (unit2)
675# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
676
677# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
678 xrows = line_count
679# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
680 yrows = 1
681# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
682 index_x = 0
683# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
684 if (num_dims == 2) index_x = i
685# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
686#ifdef MFC_DEBUG
687# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
688 block
689# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
690 use iso_fortran_env, only: output_unit
691# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
692
693# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
694 print *, 'm_icpp_patches.fpp:204: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
695# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
696
697# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
698 call flush (output_unit)
699# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
700 end block
701# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
702#endif
703# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
704 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
705# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
706
707# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
708
709# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
710
711# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
712#if defined(MFC_OpenACC)
713# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
714!$acc enter data create(x_coords, stored_values)
715# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
716#elif defined(MFC_OpenMP)
717# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
718!$omp target enter data map(always,alloc:x_coords, stored_values)
719# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
720#endif
721# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
722
723# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
724 ! Read data from all files
725# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
726 do f = 1, max_files
727# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
728 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
729# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
730 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
731# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
732
733# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
734 do iter = 1, xrows
735# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
736 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
737# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
738 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
739# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
740 end do
741# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
742 close (unit)
743# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
744 end do
745# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
746
747# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
748 ! Calculate offsets
749# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
750 domain_xstart = x_coords(1)
751# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
752 x_step = x_cc(1) - x_cc(0)
753# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
754 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)
755# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
756 global_offset_x = nint(abs(delta_x)/x_step)
757# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
758 case (3) ! 3D case - determine grid structure
759# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
760 ! Find yRows by counting rows with same x
761# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
762 read (unit2, *, iostat=ios2) x0, y0, dummy_z
763# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
764 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
765# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
766
767# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
768 yrows = 1
769# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
770 do
771# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
772 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
773# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
774 if (ios2 /= 0) exit
775# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
776 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
777# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
778 yrows = yrows + 1
779# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
780 else
781# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
782 exit
783# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
784 end if
785# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
786 end do
787# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
788 close (unit2)
789# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
790
791# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
792 ! Count total rows
793# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
794 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
795# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
796 nrows = 0
797# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
798 do
799# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
800 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
801# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
802 if (ios2 /= 0) exit
803# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
804 nrows = nrows + 1
805# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
806 end do
807# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
808 close (unit2)
809# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
810
811# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
812 xrows = nrows/yrows
813# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
814#ifdef MFC_DEBUG
815# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
816 block
817# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
818 use iso_fortran_env, only: output_unit
819# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
820
821# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
822 print *, 'm_icpp_patches.fpp:204: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
823# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
824
825# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
826 call flush (output_unit)
827# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
828 end block
829# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
830#endif
831# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
832 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
833# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
834
835# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
836
837# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
838
839# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
840
841# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
842#if defined(MFC_OpenACC)
843# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
844!$acc enter data create(x_coords, y_coords, stored_values)
845# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
846#elif defined(MFC_OpenMP)
847# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
848!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
849# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
850#endif
851# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
852 index_x = i
853# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
854 index_y = j
855# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
856
857# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
858 ! Read all files
859# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
860 do f = 1, max_files
861# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
862 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
863# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
864 if (ios /= 0) then
865# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
866 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
867# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
868 cycle
869# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
870 end if
871# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
872
873# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
874 iter = 0
875# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
876 do iix = 1, xrows
877# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
878 do iiy = 1, yrows
879# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
880 iter = iter + 1
881# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
882 if (f == 1) then
883# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
884 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
885# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
886 else
887# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
888 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
889# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
890 end if
891# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
892 if (ios /= 0) call s_mpi_abort("Error reading data")
893# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
894 end do
895# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
896 end do
897# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
898 close (unit)
899# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
900 end do
901# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
902
903# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
904 ! Calculate offsets
905# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
906 x_step = x_cc(1) - x_cc(0)
907# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
908 y_step = y_cc(1) - y_cc(0)
909# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
910 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
911# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
912 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
913# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
914 global_offset_x = nint(abs(delta_x)/x_step)
915# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
916 global_offset_y = nint(abs(delta_y)/y_step)
917# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
918 end select
919# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
920
921# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
922 files_loaded = .true.
923# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
924 end if
925# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
926
927# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
928 ! Data assignment
929# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
930 select case (num_dims)
931# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
932 case (1)
933# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
934 idx = i + 1 + global_offset_x
935# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
936 do f = 1, sys_size
937# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
938 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
939# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
940 end do
941# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
942 case (2)
943# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
944 idx = i + 1 + global_offset_x - index_x
945# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
946 do f = 1, sys_size - 1
947# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
948 jump = merge(1, 0, f >= eqn_idx%mom%end)
949# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
950 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
951# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
952 end do
953# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
954 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
955# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
956 case (3)
957# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
958 idx = i + 1 + global_offset_x - index_x
959# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
960 idy = j + 1 + global_offset_y - index_y
961# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
962 do f = 1, sys_size - 1
963# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
964 jump = merge(1, 0, f >= eqn_idx%mom%end)
965# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
966 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
967# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
968 end do
969# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
970 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
971# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
972 end select
973# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
974 case (180) ! Shu-Osher problem
975# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
976 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
977# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
978 ! 0.2*sin(5*x)"
979# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
980 if (patch_id == 2) then
981# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
982 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
983# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
984 end if
985# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
986 case (181) ! Titarev-Torro problem
987# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
988 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
989# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
990 ! "1 + 0.1*sin(20*x*pi)"
991# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
992 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
993# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
994 case (182) ! Multi-component diffusion
995# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
996 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
997# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
998 x_mid_diffu = 0.05_wp/2.0_wp
999# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1000 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1001# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1002 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1003# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1004 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1005# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1006 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1007# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1008 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
1009# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1010
1011# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1012 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1013# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1014 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1015# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1016 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1017# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1018 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1019# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1020
1021# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1022 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
1023# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1024 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
1025# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1026 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
1027# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1028 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
1029# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1030
1031# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1032 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1033# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1034
1035# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1036 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1037# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1038
1039# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1040 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)
1041# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1042
1043# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1044 case(191) ! 1D Dual Isothermal case
1045# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1046
1047# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1048 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
1049# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1050 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1051# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1052 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
1053# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1054
1055# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1056 if (x_cc(i) <= 0.025_wp) then
1057# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1058 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
1059# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1060 else
1061# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1062 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
1063# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1064 end if
1065# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1066
1067# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1068 molar_mass_inv = 1.0_wp/2.01588_wp
1069# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1070 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1071# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1072 case default
1073# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1074 call s_int_to_str(patch_id, istr)
1075# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1076 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1077# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1078 end select
1079 end if
1080
1081 ! Updating the patch identities bookkeeping variable
1082 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1083 end if
1084 end do
1085 if (allocated(stored_values)) then
1086# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1087#ifdef MFC_DEBUG
1088# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1089 block
1090# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1091 use iso_fortran_env, only: output_unit
1092# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1093
1094# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1095 print *, 'm_icpp_patches.fpp:211: ', '@:DEALLOCATE(stored_values)'
1096# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1097
1098# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1099 call flush (output_unit)
1100# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1101 end block
1102# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1103#endif
1104# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1105
1106# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1107#if defined(MFC_OpenACC)
1108# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1109!$acc exit data delete(stored_values)
1110# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1111#elif defined(MFC_OpenMP)
1112# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1113!$omp target exit data map(release:stored_values)
1114# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1115#endif
1116# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1117 deallocate (stored_values)
1118# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1119#ifdef MFC_DEBUG
1120# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1121 block
1122# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1123 use iso_fortran_env, only: output_unit
1124# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1125
1126# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1127 print *, 'm_icpp_patches.fpp:211: ', '@:DEALLOCATE(x_coords)'
1128# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1129
1130# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1131 call flush (output_unit)
1132# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1133 end block
1134# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1135#endif
1136# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1137
1138# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1139#if defined(MFC_OpenACC)
1140# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1141!$acc exit data delete(x_coords)
1142# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1143#elif defined(MFC_OpenMP)
1144# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1145!$omp target exit data map(release:x_coords)
1146# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1147#endif
1148# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1149 deallocate (x_coords)
1150# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1151 end if
1152# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1153
1154# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1155 if (allocated(y_coords)) then
1156# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1157#ifdef MFC_DEBUG
1158# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1159 block
1160# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1161 use iso_fortran_env, only: output_unit
1162# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1163
1164# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1165 print *, 'm_icpp_patches.fpp:211: ', '@:DEALLOCATE(y_coords)'
1166# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1167
1168# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1169 call flush (output_unit)
1170# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1171 end block
1172# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1173#endif
1174# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1175
1176# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1177#if defined(MFC_OpenACC)
1178# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1179!$acc exit data delete(y_coords)
1180# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1181#elif defined(MFC_OpenMP)
1182# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1183!$omp target exit data map(release:y_coords)
1184# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1185#endif
1186# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1187 deallocate (y_coords)
1188# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1189 end if
1190
1191 end subroutine s_icpp_line_segment
1192
1193 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1194 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1195 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1196
1197 integer, intent(in) :: patch_id
1198
1199#ifdef MFC_MIXED_PRECISION
1200 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1201#else
1202 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1203#endif
1204 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1205 integer :: i, j, k !< Generic loop iterators
1206 real(wp) :: th, thickness, nturns, mya
1207 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1208
1209 integer :: xrows, yrows, nrows, iix, iiy, max_files
1210# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1211 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1212# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1213 real(wp) :: x_len, x_step, y_len, y_step
1214# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1215 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1216# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1217 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1218# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1219 real(wp) :: delta_x, delta_y
1220# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1221 character(len=100), dimension(sys_size) :: filenames !< Arrays to store all data from files
1222# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1223 character(len=200) :: errmsg
1224# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1225 real(wp), allocatable :: stored_values(:,:,:)
1226# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1227 real(wp), allocatable :: x_coords(:), y_coords(:)
1228# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1229 logical :: files_loaded = .false.
1230# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1231 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1232# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1233 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
1234# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1235 character(len=20) :: file_num_str !< For storing the file number as a string
1236# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237 character(len=20) :: zeros_part !< For the trailing zeros part
1238# 231 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
1240 ! Place any declaration of intermediate variables here
1241# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1242 real(wp) :: eps, eps_mhd, c_mhd
1243# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1244 real(wp) :: r, rmax, gam, umax, p0
1245# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1246 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1247# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1248 real(wp) :: factor
1249# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1250 real(wp) :: r0, alpha, r2
1251# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1252 real(wp) :: sina, cosa
1253# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1254 real(wp) :: r_sq
1255# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1256
1257# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1258 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
1259# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1260 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, t_facq, wq
1261# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1262 real(wp) :: rho_avg, rhou_avg, rhov_avg, e_avg
1263# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1264 real(wp) :: rhoq, pq, uq, vq, eq, vortex_eps
1265# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1266 integer :: igq, jgq
1267# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1268
1269# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1270 ! # 291 - Shear/Thermal Layer Case
1271# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1272 real(wp) :: delta_shear, u_max, u_mean
1273# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1274 real(wp) :: t_wall, t_inf, p_atm, t_loc
1275# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276 real(wp) :: delta_th, r_mix
1277# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278 real(wp) :: y_n2, y_o2, mw_n2, mw_o2
1279# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280 real(wp) :: bottom_blend_u, bottom_blend_t
1281# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282
1283# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284 ! # 207
1285# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 real(wp) :: sigma, gauss1, gauss2
1287# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288
1289# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290 ! # 208
1291# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1293# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1294
1295# 232 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1296 eps = 1.e-9_wp
1297
1298 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1299 x_centroid = patch_icpp(patch_id)%x_centroid
1300 y_centroid = patch_icpp(patch_id)%y_centroid
1301 mya = patch_icpp(patch_id)%radius
1302 thickness = patch_icpp(patch_id)%length_x
1303 nturns = patch_icpp(patch_id)%length_y
1304
1305 !
1306 logic_grid = 0
1307 do k = 0, int(m*91*nturns)
1308 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1309
1310 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1311 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1312
1313 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1314 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1315
1316 do j = 0, n; do i = 0, m
1317 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) &
1318 & < spiral_y_max)) then
1319 logic_grid(i, j, 0) = 1
1320 end if
1321 end do; end do
1322 end do
1323
1324 do j = 0, n
1325 do i = 0, m
1326 if ((logic_grid(i, j, 0) == 1)) then
1327 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1328
1329
1330 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1331 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1332# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1333 case (200) ! Two-fluid cubic interface
1334# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1335 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1336# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1337 ! Volume Fractions
1338# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1339 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
1340# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1341 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
1342# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1343 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
1344# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1345 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
1346# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1347 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
1348# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1349 end if
1350# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1351 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1352# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1353 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1354# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1355 rmax = 0.2_wp
1356# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1357
1358# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1359 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1360# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1361 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1362# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1363 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1364# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1365
1366# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1367 if (r < rmax) then
1368# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1369 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1370# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1371 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1372# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1373 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1374# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1375 else if (r < 2*rmax) then
1376# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1377 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1378# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1379 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1380# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1381 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)))
1382# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1383 else
1384# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1385 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1386# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1387 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1388# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1389 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1390# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1391 end if
1392# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1393 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1394# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1395 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1396# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1397 rmax = 0.2_wp
1398# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1399
1400# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1401 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1402# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1403 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1404# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1405 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1406# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1407
1408# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1409 if (r < rmax) then
1410# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1411 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1412# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1413 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1414# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1415 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1416# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1417 else if (r < 2*rmax) then
1418# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1419 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1420# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1421 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1422# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1423 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)))
1424# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1425 else
1426# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1427 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1428# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1429 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1430# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1431 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1432# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1433 end if
1434# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1435
1436# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1437 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
1438# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1439 case (204) ! Rayleigh-Taylor instability
1440# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1441 rhoh = 3._wp
1442# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1443 rhol = 1._wp
1444# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1445 pref = 1.e5_wp
1446# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1447 pint = pref
1448# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1449 h = 0.7_wp
1450# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1451 lam = 0.2_wp
1452# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1453 wl = 2._wp*pi/lam
1454# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1455 amp = 0.05_wp/wl
1456# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1457
1458# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1460# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461
1462# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1464# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465
1466# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467 if (alph < eps) alph = eps
1468# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469 if (alph > 1._wp - eps) alph = 1._wp - eps
1470# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471
1472# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 if (y_cc(j) > inth) then
1474# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1476# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1478# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1480# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1482# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1484# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485 else
1486# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1488# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1490# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1492# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1494# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1496# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1498# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1499 end if
1500# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1501 case (205) ! 2D lung wave interaction problem
1502# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1503 h = 0.0_wp ! non dim origin y
1504# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1505 lam = 1.0_wp ! non dim lambda
1506# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1507 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1508# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1509
1510# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1511 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1512# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1513
1514# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1515 if (y_cc(j) > inth) then
1516# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1517 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1518# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1519 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1520# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1521 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1522# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1523 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1524# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1525 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1526# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1527 end if
1528# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1529 case (206) ! 2D lung wave interaction problem - horizontal domain
1530# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531 h = 0.0_wp ! non dim origin y
1532# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1533 lam = 1.0_wp ! non dim lambda
1534# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1535 amp = patch_icpp(patch_id)%a(2)
1536# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1537
1538# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1539 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1540# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1541
1542# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1543 if (x_cc(i) > intl) then ! this is the liquid
1544# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1545 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1546# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1547 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1548# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1549 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1550# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1551 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1552# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1553 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1554# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1555 end if
1556# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1557 case (207) ! Kelvin Helmholtz Instability
1558# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1559 sigma = 0.05_wp/sqrt(2.0_wp)
1560# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1561 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1562# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1563 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1564# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1565 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)
1566# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1567 case (208) ! Richtmeyer Meshkov Instability
1568# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1569 lam = 1.0_wp
1570# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1571 eps = 1.0e-6_wp
1572# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1573 ei = 5.0_wp
1574# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1575 ! Smoothening function to smooth out sharp discontinuity in the interface
1576# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1577 if (x_cc(i) <= 0.7_wp*lam) then
1578# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1579 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1580# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1581 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1582# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1583 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1584# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1585 alpha_sf6 = 1.0_wp - alpha_air
1586# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1587 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
1588# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1589 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
1590# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1591 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
1592# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1593 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
1594# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1595 end if
1596# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1597 case (250) ! MHD Orszag-Tang vortex
1598# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1599 ! 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),
1600# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1601 ! sin(4*pi*x)/sqrt(4*pi), 0)
1602# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1603
1604# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1605 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1606# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1607 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1608# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1609
1610# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1611 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1612# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1613 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1614# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1615 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1616# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1617 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1618# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1619 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
1620# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1621 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
1622# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1623 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1624# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1625 ! Linear interpolation between r=0.08 and r=1.0
1626# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1627 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1628# 267 "/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_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1630# 267 "/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_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1632# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1633 else
1634# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1635 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
1636# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1637 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
1638# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1639 end if
1640# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1641
1642# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1643 ! case 252 is for the 2D MHD Rotor problem
1644# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1645 case (252) ! 2D MHD Rotor Problem
1646# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1647 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1648# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1649 !
1650# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1651 ! 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
1652# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1653 ! velocity w=20, giving v_tan=2 at r=0.1
1654# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1655
1656# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1657 ! Calculate distance squared from the center
1658# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1659 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1660# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1661
1662# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1663 ! inner radius of 0.1
1664# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1665 if (r_sq <= 0.1**2) then
1666# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1667 ! -- Inside the rotor -- Set density uniformly to 10
1668# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1669 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
1670# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1671
1672# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1673 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1674# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1675 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1676# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1677 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1678# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1679
1680# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1681 ! taper width of 0.015
1682# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1683 else if (r_sq <= 0.115**2) then
1684# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1685 ! linearly smooth the function between r = 0.1 and 0.115
1686# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1687 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1688# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1689
1690# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1691 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)
1692# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1693 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)
1694# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1695 end if
1696# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1697 case (253) ! MHD Smooth Magnetic Vortex
1698# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1699 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1700# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1701 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1702# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1703
1704# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1705 ! velocity
1706# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1707 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))
1708# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1709 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))
1710# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1711
1712# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1713 ! magnetic field
1714# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1715 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)
1716# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1717 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)
1718# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1719
1720# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1721 ! pressure
1722# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1723 q_prim_vf(eqn_idx%E)%sf(i, j, &
1724# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1725 & 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)
1726# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1727 case (260) ! Gaussian Divergence Pulse
1728# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1729 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1730# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1731 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1732# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1733 ! initialized to zero everywhere.
1734# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1735
1736# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1737 eps_mhd = patch_icpp(patch_id)%a(2)
1738# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1739 sigma = patch_icpp(patch_id)%a(3)
1740# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1741 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1742# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1743
1744# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1745 ! B-field
1746# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1747 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1748# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1749 case (261) ! Blob
1750# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1751 r0 = 1._wp/sqrt(8._wp)
1752# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1753 r2 = x_cc(i)**2 + y_cc(j)**2
1754# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1755 r = sqrt(r2)
1756# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1757 alpha = r/r0
1758# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1759 if (alpha < 1) then
1760# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1761 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)
1762# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1763 ! 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)
1764# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1765 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1766# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1767 ! 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
1768# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1769 end if
1770# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1771 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
1772# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1773 ! rotate by \alpha = atan(2)
1774# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1775 alpha = atan(2._wp)
1776# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1777 cosa = cos(alpha)
1778# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1779 sina = sin(alpha)
1780# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1781 ! projection along shock normal
1782# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1783 r = x_cc(i)*cosa + y_cc(j)*sina
1784# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1785
1786# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1787 if (r <= 0.5_wp) then
1788# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1789 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1790# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1791 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1792# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1793 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
1794# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1795 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
1796# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1797 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
1798# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1799 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
1800# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1801 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
1802# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1803 else
1804# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1805 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1806# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1807 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1808# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1809 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
1810# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1811 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
1812# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1813 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
1814# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1815 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
1816# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1817 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
1818# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1819 end if
1820# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1821 ! v^z and B^z remain zero by default
1822# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1823 case (270) ! 2D extrusion of 1D profile from external data
1824# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1825 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1826# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1827 if (.not. files_loaded) then
1828# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1829 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1830# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1831 do f = 1, max_files
1832# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1833 write (file_num_str, '(I0)') f
1834# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1835 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
1836# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1837 end do
1838# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1839
1840# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1841 ! Common file reading setup
1842# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1843 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1844# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1845 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
1846# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1847
1848# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1849 select case (num_dims)
1850# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1851 case (1, 2) ! 1D and 2D cases are similar
1852# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1853 ! Count lines
1854# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1855 line_count = 0
1856# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1857 do
1858# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1859 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1860# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1861 if (ios2 /= 0) exit
1862# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1863 line_count = line_count + 1
1864# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1865 end do
1866# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1867 close (unit2)
1868# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1869
1870# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1871 xrows = line_count
1872# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1873 yrows = 1
1874# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1875 index_x = 0
1876# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1877 if (num_dims == 2) index_x = i
1878# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1879#ifdef MFC_DEBUG
1880# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1881 block
1882# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1883 use iso_fortran_env, only: output_unit
1884# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1885
1886# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1887 print *, 'm_icpp_patches.fpp:267: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1888# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1889
1890# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1891 call flush (output_unit)
1892# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1893 end block
1894# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1895#endif
1896# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1897 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1898# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1899
1900# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1901
1902# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1903
1904# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1905#if defined(MFC_OpenACC)
1906# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1907!$acc enter data create(x_coords, stored_values)
1908# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1909#elif defined(MFC_OpenMP)
1910# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1911!$omp target enter data map(always,alloc:x_coords, stored_values)
1912# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1913#endif
1914# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1915
1916# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1917 ! Read data from all files
1918# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1919 do f = 1, max_files
1920# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1921 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1922# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1923 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
1924# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1925
1926# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1927 do iter = 1, xrows
1928# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1929 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
1930# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1931 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
1932# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1933 end do
1934# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1935 close (unit)
1936# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1937 end do
1938# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1939
1940# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1941 ! Calculate offsets
1942# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1943 domain_xstart = x_coords(1)
1944# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1945 x_step = x_cc(1) - x_cc(0)
1946# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1947 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)
1948# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1949 global_offset_x = nint(abs(delta_x)/x_step)
1950# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1951 case (3) ! 3D case - determine grid structure
1952# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1953 ! Find yRows by counting rows with same x
1954# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1955 read (unit2, *, iostat=ios2) x0, y0, dummy_z
1956# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1957 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
1958# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1959
1960# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1961 yrows = 1
1962# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1963 do
1964# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1965 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1966# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1967 if (ios2 /= 0) exit
1968# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1969 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
1970# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1971 yrows = yrows + 1
1972# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1973 else
1974# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1975 exit
1976# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1977 end if
1978# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1979 end do
1980# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1981 close (unit2)
1982# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1983
1984# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1985 ! Count total rows
1986# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1987 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1988# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1989 nrows = 0
1990# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1991 do
1992# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1993 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
1994# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1995 if (ios2 /= 0) exit
1996# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1997 nrows = nrows + 1
1998# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1999 end do
2000# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2001 close (unit2)
2002# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2003
2004# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2005 xrows = nrows/yrows
2006# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2007#ifdef MFC_DEBUG
2008# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2009 block
2010# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2011 use iso_fortran_env, only: output_unit
2012# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2013
2014# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2015 print *, 'm_icpp_patches.fpp:267: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2016# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2017
2018# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2019 call flush (output_unit)
2020# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2021 end block
2022# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2023#endif
2024# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2025 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2026# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2027
2028# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2029
2030# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2031
2032# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2033
2034# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2035#if defined(MFC_OpenACC)
2036# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2037!$acc enter data create(x_coords, y_coords, stored_values)
2038# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2039#elif defined(MFC_OpenMP)
2040# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2041!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2042# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2043#endif
2044# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2045 index_x = i
2046# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2047 index_y = j
2048# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2049
2050# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2051 ! Read all files
2052# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2053 do f = 1, max_files
2054# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2055 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2056# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2057 if (ios /= 0) then
2058# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2059 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2060# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2061 cycle
2062# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2063 end if
2064# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2065
2066# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2067 iter = 0
2068# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2069 do iix = 1, xrows
2070# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2071 do iiy = 1, yrows
2072# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2073 iter = iter + 1
2074# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2075 if (f == 1) then
2076# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2077 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2078# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2079 else
2080# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2081 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2082# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2083 end if
2084# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2085 if (ios /= 0) call s_mpi_abort("Error reading data")
2086# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2087 end do
2088# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2089 end do
2090# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2091 close (unit)
2092# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2093 end do
2094# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2095
2096# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2097 ! Calculate offsets
2098# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2099 x_step = x_cc(1) - x_cc(0)
2100# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2101 y_step = y_cc(1) - y_cc(0)
2102# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2103 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2104# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2105 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2106# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2107 global_offset_x = nint(abs(delta_x)/x_step)
2108# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2109 global_offset_y = nint(abs(delta_y)/y_step)
2110# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2111 end select
2112# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2113
2114# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2115 files_loaded = .true.
2116# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2117 end if
2118# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2119
2120# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2121 ! Data assignment
2122# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2123 select case (num_dims)
2124# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2125 case (1)
2126# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2127 idx = i + 1 + global_offset_x
2128# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2129 do f = 1, sys_size
2130# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2131 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2132# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2133 end do
2134# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2135 case (2)
2136# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2137 idx = i + 1 + global_offset_x - index_x
2138# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2139 do f = 1, sys_size - 1
2140# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2141 jump = merge(1, 0, f >= eqn_idx%mom%end)
2142# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2143 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2144# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2145 end do
2146# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2147 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2148# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2149 case (3)
2150# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2151 idx = i + 1 + global_offset_x - index_x
2152# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2153 idy = j + 1 + global_offset_y - index_y
2154# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2155 do f = 1, sys_size - 1
2156# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2157 jump = merge(1, 0, f >= eqn_idx%mom%end)
2158# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2159 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2160# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2161 end do
2162# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2163 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2164# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2165 end select
2166# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2167 case (280) ! Isentropic vortex
2168# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2169 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
2170# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2171 ! geometry 2
2172# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2173 if (patch_id == 1) then
2174# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2175 q_prim_vf(eqn_idx%E)%sf(i, j, &
2176# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2177 & 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) &
2178# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2179 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
2180# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2181 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2182# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2183 & 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) &
2184# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2185 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
2186# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2187 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2188# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2189 & 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) &
2190# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2191 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2192# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2193 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2194# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2195 & 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) &
2196# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2197 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2198# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2199 end if
2200# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2201 case (281) ! Acoustic pulse
2202# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2203 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
2204# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2205 ! geometry 2
2206# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2207 if (patch_id == 2) then
2208# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2209 q_prim_vf(eqn_idx%E)%sf(i, j, &
2210# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2211 & 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))
2212# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2213 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2214# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2215 & 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))
2216# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2217 end if
2218# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2219 case (282) ! Zero-circulation vortex
2220# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2221 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
2222# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2223 ! geometry 2
2224# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2225 if (patch_id == 2) then
2226# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2227 q_prim_vf(eqn_idx%E)%sf(i, j, &
2228# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2229 & 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))
2230# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2231 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
2232# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2233 & 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))
2234# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2235 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
2236# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2237 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2238# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2239 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
2240# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2241 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2242# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2243 end if
2244# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2245 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
2246# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2247 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
2248# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2249 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
2250# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2251 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
2252# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2253 ! patch_icpp(patch_id)%epsilon; defaults to 5.
2254# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2255 if (patch_id == 1) then
2256# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2257 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
2258# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2259 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
2260# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2261 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
2262# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2263 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
2264# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2265 do igq = 1, 3
2266# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2267 do jgq = 1, 3
2268# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2269 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
2270# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2271 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
2272# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2273 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
2274# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2275 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))
2276# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2277 wq = gauss_w(igq)*gauss_w(jgq)
2278# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2279 rhoq = t_facq**1.4_wp
2280# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2281 pq = t_facq**2.4_wp
2282# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2283 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2284# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2285 & - r2q)
2286# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2287 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
2288# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2289 & - r2q)
2290# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2291 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
2292# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2293 rho_avg = rho_avg + wq*rhoq
2294# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2295 rhou_avg = rhou_avg + wq*(rhoq*uq)
2296# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2297 rhov_avg = rhov_avg + wq*(rhoq*vq)
2298# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2299 e_avg = e_avg + wq*eq
2300# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2301 end do
2302# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2303 end do
2304# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2305 rho_avg = rho_avg*0.25_wp
2306# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2307 rhou_avg = rhou_avg*0.25_wp
2308# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2309 rhov_avg = rhov_avg*0.25_wp
2310# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2311 e_avg = e_avg*0.25_wp
2312# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2313 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
2314# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2315 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
2316# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2317 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
2318# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2319 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
2320# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2321 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
2322# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2323 end if
2324# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2325 case (291) ! Isothermal Flat Plate
2326# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2327 t_inf = 1125.0_wp
2328# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2329 t_wall = 600.0_wp
2330# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2331 p_atm = 101325.0_wp
2332# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2333
2334# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2335 ! Boundary/Shear Layer thicknesses
2336# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2337 delta_th = 0.0003_wp ! Thermal BL thickness
2338# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2339 delta_shear = 8e-3_wp ! Velocity BL thickness
2340# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2341
2342# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2343 u_max = 50.0_wp ! Freestream Velocity (m/s)
2344# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2345
2346# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2347 mw_n2 = 28.0134e-3_wp
2348# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2349 mw_o2 = 31.999e-3_wp
2350# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2351 y_n2 = 0.767_wp
2352# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2353 y_o2 = 0.233_wp
2354# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2355 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
2356# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2357 bottom_blend_u = tanh(y_cc(j)/delta_shear)
2358# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2359 bottom_blend_t = tanh(y_cc(j)/delta_th)
2360# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361 u_mean = u_max*bottom_blend_u
2362# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
2364# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
2366# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
2368# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2370# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
2372# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
2374# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
2376# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377 case default
2378# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379 if (proc_rank == 0) then
2380# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381 call s_int_to_str(patch_id, istr)
2382# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
2384# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385 end if
2386# 267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387 end select
2388 end if
2389
2390 ! Updating the patch identities bookkeeping variable
2391 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2392 end if
2393 end do
2394 end do
2395 if (allocated(stored_values)) then
2396# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2397#ifdef MFC_DEBUG
2398# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2399 block
2400# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2401 use iso_fortran_env, only: output_unit
2402# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2403
2404# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2405 print *, 'm_icpp_patches.fpp:275: ', '@:DEALLOCATE(stored_values)'
2406# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2407
2408# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2409 call flush (output_unit)
2410# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2411 end block
2412# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2413#endif
2414# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2415
2416# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2417#if defined(MFC_OpenACC)
2418# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2419!$acc exit data delete(stored_values)
2420# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2421#elif defined(MFC_OpenMP)
2422# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2423!$omp target exit data map(release:stored_values)
2424# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2425#endif
2426# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2427 deallocate (stored_values)
2428# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2429#ifdef MFC_DEBUG
2430# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2431 block
2432# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2433 use iso_fortran_env, only: output_unit
2434# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2435
2436# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2437 print *, 'm_icpp_patches.fpp:275: ', '@:DEALLOCATE(x_coords)'
2438# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2439
2440# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2441 call flush (output_unit)
2442# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2443 end block
2444# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2445#endif
2446# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2447
2448# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2449#if defined(MFC_OpenACC)
2450# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2451!$acc exit data delete(x_coords)
2452# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2453#elif defined(MFC_OpenMP)
2454# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2455!$omp target exit data map(release:x_coords)
2456# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2457#endif
2458# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2459 deallocate (x_coords)
2460# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2461 end if
2462# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2463
2464# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2465 if (allocated(y_coords)) then
2466# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2467#ifdef MFC_DEBUG
2468# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2469 block
2470# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2471 use iso_fortran_env, only: output_unit
2472# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2473
2474# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2475 print *, 'm_icpp_patches.fpp:275: ', '@:DEALLOCATE(y_coords)'
2476# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2477
2478# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2479 call flush (output_unit)
2480# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2481 end block
2482# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2483#endif
2484# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2485
2486# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2487#if defined(MFC_OpenACC)
2488# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2489!$acc exit data delete(y_coords)
2490# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2491#elif defined(MFC_OpenMP)
2492# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2493!$omp target exit data map(release:y_coords)
2494# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2495#endif
2496# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2497 deallocate (y_coords)
2498# 275 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2499 end if
2500
2501 end subroutine s_icpp_spiral
2502
2503 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
2504 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
2505 !! its boundary.
2506 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2507
2508 integer, intent(in) :: patch_id
2509
2510#ifdef MFC_MIXED_PRECISION
2511 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2512#else
2513 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
2514#endif
2515 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2516 real(wp) :: radius
2517 integer :: i, j, k !< Generic loop iterators
2518
2519 integer :: xRows, yRows, nRows, iix, iiy, max_files
2520# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2521 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2522# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2523 real(wp) :: x_len, x_step, y_len, y_step
2524# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2525 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2526# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2527 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
2528# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2529 real(wp) :: delta_x, delta_y
2530# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2531 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
2532# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2533 character(len=200) :: errmsg
2534# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2535 real(wp), allocatable :: stored_values(:,:,:)
2536# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2537 real(wp), allocatable :: x_coords(:), y_coords(:)
2538# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2539 logical :: files_loaded = .false.
2540# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2541 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2542# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2543 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
2544# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2545 character(len=20) :: file_num_str !< For storing the file number as a string
2546# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2547 character(len=20) :: zeros_part !< For the trailing zeros part
2548# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2549 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
2550 ! Place any declaration of intermediate variables here
2551# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2552 real(wp) :: eps, eps_mhd, C_mhd
2553# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2554 real(wp) :: r, rmax, gam, umax, p0
2555# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2556 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2557# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2558 real(wp) :: factor
2559# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2560 real(wp) :: r0, alpha, r2
2561# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2562 real(wp) :: sinA, cosA
2563# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2564 real(wp) :: r_sq
2565# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2566
2567# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2568 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
2569# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2570 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
2571# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2572 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
2573# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2574 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
2575# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2576 integer :: igq, jgq
2577# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2578
2579# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2580 ! # 291 - Shear/Thermal Layer Case
2581# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2582 real(wp) :: delta_shear, u_max, u_mean
2583# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2584 real(wp) :: T_wall, T_inf, P_atm, T_loc
2585# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2586 real(wp) :: delta_th, R_mix
2587# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2588 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
2589# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2590 real(wp) :: bottom_blend_u, bottom_blend_T
2591# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2592
2593# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2594 ! # 207
2595# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2596 real(wp) :: sigma, gauss1, gauss2
2597# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2598
2599# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2600 ! # 208
2601# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2602 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2603# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2604
2605# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2606 eps = 1.e-9_wp
2607
2608 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
2609
2610 x_centroid = patch_icpp(patch_id)%x_centroid
2611 y_centroid = patch_icpp(patch_id)%y_centroid
2612 radius = patch_icpp(patch_id)%radius
2613 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2614 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2615
2616 ! Initialize eta=1; modified if smoothing is enabled
2617 eta = 1._wp
2618
2619 ! Assign patch vars if cell is covered and patch has write permission
2620
2621 do j = 0, n
2622 do i = 0, m
2623 if (patch_icpp(patch_id)%smoothen) then
2624 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
2625 eta = tanh(smooth_coeff/min(dx, &
2626 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
2627 end if
2628
2629 if (((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2 <= radius**2 &
2630 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
2631 & 0) == smooth_patch_id) then
2632 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
2633
2634
2635 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2636 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2637# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2638 case (200) ! Two-fluid cubic interface
2639# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2640 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2641# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2642 ! Volume Fractions
2643# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2644 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
2645# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2646 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
2647# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2648 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
2649# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2650 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
2651# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2652 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
2653# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2654 end if
2655# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2656 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2657# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2658 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2659# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2660 rmax = 0.2_wp
2661# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2662
2663# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2664 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2665# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2666 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2667# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2668 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2669# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2670
2671# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2672 if (r < rmax) then
2673# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2674 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2675# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2676 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2677# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2678 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2679# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2680 else if (r < 2*rmax) then
2681# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2682 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2683# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2684 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2685# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2686 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)))
2687# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2688 else
2689# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2690 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2691# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2692 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2693# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2694 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2695# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2696 end if
2697# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2698 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2699# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2700 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2701# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2702 rmax = 0.2_wp
2703# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2704
2705# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2706 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2707# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2708 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2709# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2710 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2711# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2712
2713# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2714 if (r < rmax) then
2715# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2716 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2717# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2718 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2719# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2720 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2721# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2722 else if (r < 2*rmax) then
2723# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2724 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2725# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2726 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2727# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2728 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)))
2729# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2730 else
2731# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2732 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
2733# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2734 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
2735# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2736 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2737# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2738 end if
2739# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2740
2741# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2742 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
2743# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2744 case (204) ! Rayleigh-Taylor instability
2745# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2746 rhoh = 3._wp
2747# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2748 rhol = 1._wp
2749# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2750 pref = 1.e5_wp
2751# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2752 pint = pref
2753# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2754 h = 0.7_wp
2755# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2756 lam = 0.2_wp
2757# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2758 wl = 2._wp*pi/lam
2759# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2760 amp = 0.05_wp/wl
2761# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2762
2763# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2764 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2765# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2766
2767# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2768 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2769# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2770
2771# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2772 if (alph < eps) alph = eps
2773# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2774 if (alph > 1._wp - eps) alph = 1._wp - eps
2775# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2776
2777# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2778 if (y_cc(j) > inth) then
2779# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2780 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2781# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2782 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2783# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2784 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2785# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2786 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2787# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2788 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2789# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2790 else
2791# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2792 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
2793# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2794 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
2795# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2796 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
2797# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2798 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
2799# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2800 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2801# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2802 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2803# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2804 end if
2805# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2806 case (205) ! 2D lung wave interaction problem
2807# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2808 h = 0.0_wp ! non dim origin y
2809# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2810 lam = 1.0_wp ! non dim lambda
2811# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2812 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
2813# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2814
2815# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2816 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2817# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2818
2819# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2820 if (y_cc(j) > inth) then
2821# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2822 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2823# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2824 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2825# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2826 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2827# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2828 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2829# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2830 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2831# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2832 end if
2833# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2834 case (206) ! 2D lung wave interaction problem - horizontal domain
2835# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2836 h = 0.0_wp ! non dim origin y
2837# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2838 lam = 1.0_wp ! non dim lambda
2839# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2840 amp = patch_icpp(patch_id)%a(2)
2841# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2842
2843# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2844 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2845# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2846
2847# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2848 if (x_cc(i) > intl) then ! this is the liquid
2849# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2850 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2851# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2852 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2853# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2854 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
2855# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2856 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2857# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2858 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2859# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2860 end if
2861# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2862 case (207) ! Kelvin Helmholtz Instability
2863# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2864 sigma = 0.05_wp/sqrt(2.0_wp)
2865# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2866 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2867# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2868 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2869# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2870 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)
2871# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2872 case (208) ! Richtmeyer Meshkov Instability
2873# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2874 lam = 1.0_wp
2875# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2876 eps = 1.0e-6_wp
2877# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2878 ei = 5.0_wp
2879# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2880 ! Smoothening function to smooth out sharp discontinuity in the interface
2881# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2882 if (x_cc(i) <= 0.7_wp*lam) then
2883# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2884 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2885# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2886 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2887# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2888 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2889# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2890 alpha_sf6 = 1.0_wp - alpha_air
2891# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2892 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
2893# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2894 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
2895# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2896 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
2897# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2898 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
2899# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2900 end if
2901# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2902 case (250) ! MHD Orszag-Tang vortex
2903# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2904 ! 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),
2905# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2906 ! sin(4*pi*x)/sqrt(4*pi), 0)
2907# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2908
2909# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2910 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2911# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2912 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2913# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2914
2915# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2916 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2917# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2918 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2919# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2920 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2921# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2922 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2923# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2924 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
2925# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2926 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
2927# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2928 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2929# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2930 ! Linear interpolation between r=0.08 and r=1.0
2931# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2932 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2933# 326 "/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_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2935# 326 "/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_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2937# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2938 else
2939# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2940 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
2941# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2942 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
2943# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2944 end if
2945# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2946
2947# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2948 ! case 252 is for the 2D MHD Rotor problem
2949# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2950 case (252) ! 2D MHD Rotor Problem
2951# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2952 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
2953# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2954 !
2955# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2956 ! 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
2957# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2958 ! velocity w=20, giving v_tan=2 at r=0.1
2959# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2960
2961# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2962 ! Calculate distance squared from the center
2963# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2964 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2965# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2966
2967# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2968 ! inner radius of 0.1
2969# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2970 if (r_sq <= 0.1**2) then
2971# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2972 ! -- Inside the rotor -- Set density uniformly to 10
2973# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2974 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
2975# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2976
2977# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2978 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
2979# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2980 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2981# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2982 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2983# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2984
2985# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2986 ! taper width of 0.015
2987# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2988 else if (r_sq <= 0.115**2) then
2989# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2990 ! linearly smooth the function between r = 0.1 and 0.115
2991# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2992 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2993# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2994
2995# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2996 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)
2997# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2998 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)
2999# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3000 end if
3001# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3002 case (253) ! MHD Smooth Magnetic Vortex
3003# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3004 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
3005# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3006 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
3007# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3008
3009# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3010 ! velocity
3011# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3012 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))
3013# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3014 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))
3015# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3016
3017# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3018 ! magnetic field
3019# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3020 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)
3021# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3022 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)
3023# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3024
3025# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3026 ! pressure
3027# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3028 q_prim_vf(eqn_idx%E)%sf(i, j, &
3029# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3030 & 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)
3031# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3032 case (260) ! Gaussian Divergence Pulse
3033# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3034 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
3035# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3036 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
3037# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3038 ! initialized to zero everywhere.
3039# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3040
3041# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3042 eps_mhd = patch_icpp(patch_id)%a(2)
3043# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3044 sigma = patch_icpp(patch_id)%a(3)
3045# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3046 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3047# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3048
3049# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3050 ! B-field
3051# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3052 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3053# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3054 case (261) ! Blob
3055# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3056 r0 = 1._wp/sqrt(8._wp)
3057# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3058 r2 = x_cc(i)**2 + y_cc(j)**2
3059# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3060 r = sqrt(r2)
3061# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3062 alpha = r/r0
3063# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3064 if (alpha < 1) then
3065# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3066 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)
3067# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3068 ! 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)
3069# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3070 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
3071# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3072 ! 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
3073# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3074 end if
3075# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3076 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
3077# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3078 ! rotate by \alpha = atan(2)
3079# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3080 alpha = atan(2._wp)
3081# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3082 cosa = cos(alpha)
3083# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3084 sina = sin(alpha)
3085# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3086 ! projection along shock normal
3087# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3088 r = x_cc(i)*cosa + y_cc(j)*sina
3089# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3090
3091# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3092 if (r <= 0.5_wp) then
3093# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3094 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
3095# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3096 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3097# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3098 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
3099# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3100 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
3101# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3102 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
3103# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3104 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
3105# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3106 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
3107# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3108 else
3109# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3110 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
3111# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3112 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
3113# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3114 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
3115# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3116 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
3117# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3118 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
3119# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3120 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
3121# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3122 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
3123# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3124 end if
3125# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3126 ! v^z and B^z remain zero by default
3127# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3128 case (270) ! 2D extrusion of 1D profile from external data
3129# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3130 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
3131# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3132 if (.not. files_loaded) then
3133# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3134 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3135# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3136 do f = 1, max_files
3137# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3138 write (file_num_str, '(I0)') f
3139# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3140 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
3141# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3142 end do
3143# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3144
3145# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3146 ! Common file reading setup
3147# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3148 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3149# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3150 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3151# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3152
3153# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3154 select case (num_dims)
3155# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3156 case (1, 2) ! 1D and 2D cases are similar
3157# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3158 ! Count lines
3159# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3160 line_count = 0
3161# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3162 do
3163# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3164 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3165# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3166 if (ios2 /= 0) exit
3167# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3168 line_count = line_count + 1
3169# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3170 end do
3171# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3172 close (unit2)
3173# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3174
3175# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3176 xrows = line_count
3177# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3178 yrows = 1
3179# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3180 index_x = 0
3181# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3182 if (num_dims == 2) index_x = i
3183# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3184#ifdef MFC_DEBUG
3185# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3186 block
3187# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3188 use iso_fortran_env, only: output_unit
3189# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3190
3191# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3192 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3193# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3194
3195# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3196 call flush (output_unit)
3197# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3198 end block
3199# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3200#endif
3201# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3202 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3203# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3204
3205# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3206
3207# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3208
3209# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3210#if defined(MFC_OpenACC)
3211# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3212!$acc enter data create(x_coords, stored_values)
3213# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3214#elif defined(MFC_OpenMP)
3215# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3216!$omp target enter data map(always,alloc:x_coords, stored_values)
3217# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3218#endif
3219# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3220
3221# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3222 ! Read data from all files
3223# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3224 do f = 1, max_files
3225# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3226 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3227# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3228 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3229# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3230
3231# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3232 do iter = 1, xrows
3233# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3234 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3235# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3236 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3237# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3238 end do
3239# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3240 close (unit)
3241# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3242 end do
3243# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3244
3245# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3246 ! Calculate offsets
3247# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3248 domain_xstart = x_coords(1)
3249# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3250 x_step = x_cc(1) - x_cc(0)
3251# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3252 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)
3253# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3254 global_offset_x = nint(abs(delta_x)/x_step)
3255# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3256 case (3) ! 3D case - determine grid structure
3257# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3258 ! Find yRows by counting rows with same x
3259# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3260 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3261# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3262 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3263# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3264
3265# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3266 yrows = 1
3267# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3268 do
3269# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3270 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3271# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3272 if (ios2 /= 0) exit
3273# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3274 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3275# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3276 yrows = yrows + 1
3277# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3278 else
3279# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3280 exit
3281# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3282 end if
3283# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3284 end do
3285# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3286 close (unit2)
3287# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3288
3289# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3290 ! Count total rows
3291# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3292 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3293# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3294 nrows = 0
3295# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3296 do
3297# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3298 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3299# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3300 if (ios2 /= 0) exit
3301# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3302 nrows = nrows + 1
3303# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3304 end do
3305# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3306 close (unit2)
3307# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3308
3309# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3310 xrows = nrows/yrows
3311# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3312#ifdef MFC_DEBUG
3313# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3314 block
3315# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3316 use iso_fortran_env, only: output_unit
3317# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3318
3319# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3320 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3321# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3322
3323# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3324 call flush (output_unit)
3325# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3326 end block
3327# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3328#endif
3329# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3330 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3331# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3332
3333# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3334
3335# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3336
3337# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3338
3339# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3340#if defined(MFC_OpenACC)
3341# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3342!$acc enter data create(x_coords, y_coords, stored_values)
3343# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3344#elif defined(MFC_OpenMP)
3345# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3346!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3347# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3348#endif
3349# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3350 index_x = i
3351# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3352 index_y = j
3353# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3354
3355# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3356 ! Read all files
3357# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3358 do f = 1, max_files
3359# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3360 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3361# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3362 if (ios /= 0) then
3363# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3364 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3365# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3366 cycle
3367# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3368 end if
3369# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3370
3371# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3372 iter = 0
3373# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3374 do iix = 1, xrows
3375# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3376 do iiy = 1, yrows
3377# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3378 iter = iter + 1
3379# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3380 if (f == 1) then
3381# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3382 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3383# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3384 else
3385# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3386 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3387# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3388 end if
3389# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3390 if (ios /= 0) call s_mpi_abort("Error reading data")
3391# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3392 end do
3393# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3394 end do
3395# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3396 close (unit)
3397# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3398 end do
3399# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3400
3401# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3402 ! Calculate offsets
3403# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3404 x_step = x_cc(1) - x_cc(0)
3405# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3406 y_step = y_cc(1) - y_cc(0)
3407# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3408 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3409# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3410 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3411# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3412 global_offset_x = nint(abs(delta_x)/x_step)
3413# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3414 global_offset_y = nint(abs(delta_y)/y_step)
3415# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3416 end select
3417# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3418
3419# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3420 files_loaded = .true.
3421# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3422 end if
3423# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3424
3425# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3426 ! Data assignment
3427# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3428 select case (num_dims)
3429# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3430 case (1)
3431# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3432 idx = i + 1 + global_offset_x
3433# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3434 do f = 1, sys_size
3435# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3436 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3437# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3438 end do
3439# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3440 case (2)
3441# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3442 idx = i + 1 + global_offset_x - index_x
3443# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3444 do f = 1, sys_size - 1
3445# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3446 jump = merge(1, 0, f >= eqn_idx%mom%end)
3447# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3448 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3449# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3450 end do
3451# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3452 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3453# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3454 case (3)
3455# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3456 idx = i + 1 + global_offset_x - index_x
3457# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3458 idy = j + 1 + global_offset_y - index_y
3459# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3460 do f = 1, sys_size - 1
3461# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3462 jump = merge(1, 0, f >= eqn_idx%mom%end)
3463# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3464 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3465# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3466 end do
3467# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3468 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3469# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3470 end select
3471# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3472 case (280) ! Isentropic vortex
3473# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3474 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3475# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3476 ! geometry 2
3477# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3478 if (patch_id == 1) then
3479# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3480 q_prim_vf(eqn_idx%E)%sf(i, j, &
3481# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3482 & 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) &
3483# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3484 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3485# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3486 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3487# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3488 & 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) &
3489# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3490 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3491# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3492 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3493# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3494 & 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) &
3495# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3496 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3497# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3498 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3499# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3500 & 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) &
3501# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3502 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3503# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3504 end if
3505# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3506 case (281) ! Acoustic pulse
3507# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3508 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3509# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3510 ! geometry 2
3511# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3512 if (patch_id == 2) then
3513# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3514 q_prim_vf(eqn_idx%E)%sf(i, j, &
3515# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3516 & 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))
3517# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3518 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3519# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3520 & 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))
3521# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3522 end if
3523# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3524 case (282) ! Zero-circulation vortex
3525# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3526 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
3527# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3528 ! geometry 2
3529# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3530 if (patch_id == 2) then
3531# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3532 q_prim_vf(eqn_idx%E)%sf(i, j, &
3533# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3534 & 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))
3535# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3536 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3537# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3538 & 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))
3539# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3540 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3541# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3542 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3543# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3544 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3545# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3546 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3547# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3548 end if
3549# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3550 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
3551# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3552 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
3553# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3554 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
3555# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3556 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
3557# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3558 ! patch_icpp(patch_id)%epsilon; defaults to 5.
3559# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3560 if (patch_id == 1) then
3561# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3562 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
3563# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3564 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
3565# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3566 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
3567# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3568 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
3569# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3570 do igq = 1, 3
3571# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3572 do jgq = 1, 3
3573# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3574 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
3575# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3576 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
3577# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3578 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
3579# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3580 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))
3581# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3582 wq = gauss_w(igq)*gauss_w(jgq)
3583# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3584 rhoq = t_facq**1.4_wp
3585# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3586 pq = t_facq**2.4_wp
3587# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3588 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3589# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3590 & - r2q)
3591# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3592 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3593# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3594 & - r2q)
3595# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3596 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
3597# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3598 rho_avg = rho_avg + wq*rhoq
3599# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3600 rhou_avg = rhou_avg + wq*(rhoq*uq)
3601# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3602 rhov_avg = rhov_avg + wq*(rhoq*vq)
3603# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3604 e_avg = e_avg + wq*eq
3605# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3606 end do
3607# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3608 end do
3609# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3610 rho_avg = rho_avg*0.25_wp
3611# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3612 rhou_avg = rhou_avg*0.25_wp
3613# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3614 rhov_avg = rhov_avg*0.25_wp
3615# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3616 e_avg = e_avg*0.25_wp
3617# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3618 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
3619# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3620 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
3621# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3622 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
3623# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3624 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
3625# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3626 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
3627# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3628 end if
3629# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3630 case (291) ! Isothermal Flat Plate
3631# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3632 t_inf = 1125.0_wp
3633# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3634 t_wall = 600.0_wp
3635# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3636 p_atm = 101325.0_wp
3637# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3638
3639# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3640 ! Boundary/Shear Layer thicknesses
3641# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3642 delta_th = 0.0003_wp ! Thermal BL thickness
3643# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3644 delta_shear = 8e-3_wp ! Velocity BL thickness
3645# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3646
3647# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3648 u_max = 50.0_wp ! Freestream Velocity (m/s)
3649# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3650
3651# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3652 mw_n2 = 28.0134e-3_wp
3653# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3654 mw_o2 = 31.999e-3_wp
3655# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3656 y_n2 = 0.767_wp
3657# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3658 y_o2 = 0.233_wp
3659# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3660 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
3661# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3662 bottom_blend_u = tanh(y_cc(j)/delta_shear)
3663# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3664 bottom_blend_t = tanh(y_cc(j)/delta_th)
3665# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3666 u_mean = u_max*bottom_blend_u
3667# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3668 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
3669# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3670 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
3671# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3672 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
3673# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3674 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3675# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3676 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
3677# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3678 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
3679# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3680 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
3681# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3682 case default
3683# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3684 if (proc_rank == 0) then
3685# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3686 call s_int_to_str(patch_id, istr)
3687# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3688 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
3689# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3690 end if
3691# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3692 end select
3693 end if
3694 end if
3695 end do
3696 end do
3697 if (allocated(stored_values)) then
3698# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3699#ifdef MFC_DEBUG
3700# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3701 block
3702# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3703 use iso_fortran_env, only: output_unit
3704# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3705
3706# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3707 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(stored_values)'
3708# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3709
3710# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3711 call flush (output_unit)
3712# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3713 end block
3714# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3715#endif
3716# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3717
3718# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3719#if defined(MFC_OpenACC)
3720# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3721!$acc exit data delete(stored_values)
3722# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723#elif defined(MFC_OpenMP)
3724# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725!$omp target exit data map(release:stored_values)
3726# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727#endif
3728# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729 deallocate (stored_values)
3730# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731#ifdef MFC_DEBUG
3732# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733 block
3734# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735 use iso_fortran_env, only: output_unit
3736# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737
3738# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(x_coords)'
3740# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741
3742# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 call flush (output_unit)
3744# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745 end block
3746# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747#endif
3748# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3749
3750# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3751#if defined(MFC_OpenACC)
3752# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3753!$acc exit data delete(x_coords)
3754# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3755#elif defined(MFC_OpenMP)
3756# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3757!$omp target exit data map(release:x_coords)
3758# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3759#endif
3760# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3761 deallocate (x_coords)
3762# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3763 end if
3764# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3765
3766# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3767 if (allocated(y_coords)) then
3768# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3769#ifdef MFC_DEBUG
3770# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3771 block
3772# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3773 use iso_fortran_env, only: output_unit
3774# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3775
3776# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3777 print *, 'm_icpp_patches.fpp:331: ', '@:DEALLOCATE(y_coords)'
3778# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3779
3780# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3781 call flush (output_unit)
3782# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3783 end block
3784# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3785#endif
3786# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787
3788# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789#if defined(MFC_OpenACC)
3790# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791!$acc exit data delete(y_coords)
3792# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793#elif defined(MFC_OpenMP)
3794# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795!$omp target exit data map(release:y_coords)
3796# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797#endif
3798# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799 deallocate (y_coords)
3800# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801 end if
3802
3803 end subroutine s_icpp_circle
3804
3805 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
3806 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3807
3808 ! Patch identifier
3809 integer, intent(in) :: patch_id
3810
3811#ifdef MFC_MIXED_PRECISION
3812 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3813#else
3814 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
3815#endif
3816 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3817
3818 ! Generic loop iterators
3819 integer :: i, j, k
3820 real(wp) :: radius, myr, thickness
3821
3822 integer :: xRows, yRows, nRows, iix, iiy, max_files
3823# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3824 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3825# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3826 real(wp) :: x_len, x_step, y_len, y_step
3827# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3828 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3829# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3830 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
3831# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3832 real(wp) :: delta_x, delta_y
3833# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3834 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
3835# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3836 character(len=200) :: errmsg
3837# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3838 real(wp), allocatable :: stored_values(:,:,:)
3839# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3840 real(wp), allocatable :: x_coords(:), y_coords(:)
3841# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3842 logical :: files_loaded = .false.
3843# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3844 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3845# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3846 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
3847# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3848 character(len=20) :: file_num_str !< For storing the file number as a string
3849# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3850 character(len=20) :: zeros_part !< For the trailing zeros part
3851# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3852 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
3853 ! Place any declaration of intermediate variables here
3854# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 real(wp) :: eps, eps_mhd, C_mhd
3856# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857 real(wp) :: r, rmax, gam, umax, p0
3858# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3860# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3861 real(wp) :: factor
3862# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3863 real(wp) :: r0, alpha, r2
3864# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865 real(wp) :: sinA, cosA
3866# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 real(wp) :: r_sq
3868# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869
3870# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
3872# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
3874# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
3876# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
3878# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879 integer :: igq, jgq
3880# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881
3882# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 ! # 291 - Shear/Thermal Layer Case
3884# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 real(wp) :: delta_shear, u_max, u_mean
3886# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 real(wp) :: T_wall, T_inf, P_atm, T_loc
3888# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 real(wp) :: delta_th, R_mix
3890# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
3892# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893 real(wp) :: bottom_blend_u, bottom_blend_T
3894# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895
3896# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897 ! # 207
3898# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899 real(wp) :: sigma, gauss1, gauss2
3900# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901
3902# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 ! # 208
3904# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3906# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907
3908# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909 eps = 1.e-9_wp
3910
3911 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
3912 x_centroid = patch_icpp(patch_id)%x_centroid
3913 y_centroid = patch_icpp(patch_id)%y_centroid
3914 radius = patch_icpp(patch_id)%radius
3915 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3916 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3917 thickness = patch_icpp(patch_id)%epsilon
3918
3919 ! Initialize eta=1; modified if smoothing is enabled
3920 eta = 1._wp
3921
3922 ! Assign patch vars if cell is covered and patch has write permission
3923 do j = 0, n
3924 do i = 0, m
3925 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
3926
3927 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
3928 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
3929 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
3930
3931
3932 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3933 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3934# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3935 case (200) ! Two-fluid cubic interface
3936# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3937 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3938# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3939 ! Volume Fractions
3940# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3941 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
3942# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3943 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
3944# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
3946# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
3948# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
3950# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 end if
3952# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3954# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3956# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 rmax = 0.2_wp
3958# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959
3960# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3962# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3964# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3966# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967
3968# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969 if (r < rmax) then
3970# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3972# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3974# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3975 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3976# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3977 else if (r < 2*rmax) then
3978# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3979 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3980# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3981 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3982# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983 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)))
3984# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 else
3986# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
3988# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
3990# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
3992# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993 end if
3994# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
3996# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3998# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999 rmax = 0.2_wp
4000# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001
4002# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4004# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4006# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4008# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009
4010# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011 if (r < rmax) then
4012# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4014# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4016# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4018# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019 else if (r < 2*rmax) then
4020# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4022# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4024# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025 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)))
4026# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 else
4028# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4030# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4032# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
4034# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035 end if
4036# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037
4038# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
4040# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041 case (204) ! Rayleigh-Taylor instability
4042# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043 rhoh = 3._wp
4044# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 rhol = 1._wp
4046# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047 pref = 1.e5_wp
4048# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049 pint = pref
4050# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 h = 0.7_wp
4052# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053 lam = 0.2_wp
4054# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 wl = 2._wp*pi/lam
4056# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 amp = 0.05_wp/wl
4058# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059
4060# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
4062# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063
4064# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4066# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067
4068# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069 if (alph < eps) alph = eps
4070# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071 if (alph > 1._wp - eps) alph = 1._wp - eps
4072# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073
4074# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075 if (y_cc(j) > inth) then
4076# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4078# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4080# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4082# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4084# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4086# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087 else
4088# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4090# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4092# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4094# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4096# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4098# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
4100# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101 end if
4102# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 case (205) ! 2D lung wave interaction problem
4104# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105 h = 0.0_wp ! non dim origin y
4106# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 lam = 1.0_wp ! non dim lambda
4108# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
4110# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111
4112# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
4114# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115
4116# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117 if (y_cc(j) > inth) then
4118# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4120# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4122# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4124# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4126# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4128# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129 end if
4130# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131 case (206) ! 2D lung wave interaction problem - horizontal domain
4132# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4133 h = 0.0_wp ! non dim origin y
4134# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4135 lam = 1.0_wp ! non dim lambda
4136# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4137 amp = patch_icpp(patch_id)%a(2)
4138# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4139
4140# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4141 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4142# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4143
4144# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4145 if (x_cc(i) > intl) then ! this is the liquid
4146# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4147 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4148# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4149 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4150# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4151 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4152# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4154# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4156# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 end if
4158# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159 case (207) ! Kelvin Helmholtz Instability
4160# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161 sigma = 0.05_wp/sqrt(2.0_wp)
4162# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4164# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4166# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 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)
4168# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 case (208) ! Richtmeyer Meshkov Instability
4170# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 lam = 1.0_wp
4172# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173 eps = 1.0e-6_wp
4174# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 ei = 5.0_wp
4176# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177 ! Smoothening function to smooth out sharp discontinuity in the interface
4178# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179 if (x_cc(i) <= 0.7_wp*lam) then
4180# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4182# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
4184# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4186# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187 alpha_sf6 = 1.0_wp - alpha_air
4188# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
4190# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
4192# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
4194# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
4196# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 end if
4198# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 case (250) ! MHD Orszag-Tang vortex
4200# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 ! 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),
4202# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 ! sin(4*pi*x)/sqrt(4*pi), 0)
4204# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205
4206# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4208# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4210# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211
4212# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4214# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4216# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4218# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4220# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
4222# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
4224# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4226# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227 ! Linear interpolation between r=0.08 and r=1.0
4228# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4230# 377 "/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_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4232# 377 "/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_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4234# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235 else
4236# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
4238# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
4240# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241 end if
4242# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243
4244# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245 ! case 252 is for the 2D MHD Rotor problem
4246# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247 case (252) ! 2D MHD Rotor Problem
4248# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
4250# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251 !
4252# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253 ! 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
4254# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255 ! velocity w=20, giving v_tan=2 at r=0.1
4256# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257
4258# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259 ! Calculate distance squared from the center
4260# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4262# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263
4264# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265 ! inner radius of 0.1
4266# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4267 if (r_sq <= 0.1**2) then
4268# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269 ! -- Inside the rotor -- Set density uniformly to 10
4270# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
4272# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273
4274# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
4276# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4278# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4280# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281
4282# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283 ! taper width of 0.015
4284# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285 else if (r_sq <= 0.115**2) then
4286# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287 ! linearly smooth the function between r = 0.1 and 0.115
4288# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4290# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291
4292# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293 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)
4294# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 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)
4296# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297 end if
4298# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 case (253) ! MHD Smooth Magnetic Vortex
4300# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
4302# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4304# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305
4306# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307 ! velocity
4308# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 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))
4310# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311 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))
4312# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313
4314# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315 ! magnetic field
4316# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317 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)
4318# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319 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)
4320# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321
4322# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323 ! pressure
4324# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325 q_prim_vf(eqn_idx%E)%sf(i, j, &
4326# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327 & 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)
4328# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329 case (260) ! Gaussian Divergence Pulse
4330# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
4332# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
4334# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335 ! initialized to zero everywhere.
4336# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337
4338# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339 eps_mhd = patch_icpp(patch_id)%a(2)
4340# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4341 sigma = patch_icpp(patch_id)%a(3)
4342# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4343 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4344# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4345
4346# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4347 ! B-field
4348# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4349 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4350# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4351 case (261) ! Blob
4352# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4353 r0 = 1._wp/sqrt(8._wp)
4354# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4355 r2 = x_cc(i)**2 + y_cc(j)**2
4356# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4357 r = sqrt(r2)
4358# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4359 alpha = r/r0
4360# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4361 if (alpha < 1) then
4362# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4363 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)
4364# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4365 ! 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)
4366# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4367 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4368# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4369 ! 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
4370# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4371 end if
4372# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4373 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
4374# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4375 ! rotate by \alpha = atan(2)
4376# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4377 alpha = atan(2._wp)
4378# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4379 cosa = cos(alpha)
4380# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4381 sina = sin(alpha)
4382# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4383 ! projection along shock normal
4384# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4385 r = x_cc(i)*cosa + y_cc(j)*sina
4386# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4387
4388# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4389 if (r <= 0.5_wp) then
4390# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4391 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4392# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4393 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4394# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4395 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
4396# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4397 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
4398# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4399 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
4400# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4401 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
4402# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4403 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
4404# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4405 else
4406# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4407 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4408# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4409 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4410# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4411 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
4412# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4413 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
4414# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4415 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
4416# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4417 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
4418# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4419 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
4420# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4421 end if
4422# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4423 ! v^z and B^z remain zero by default
4424# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4425 case (270) ! 2D extrusion of 1D profile from external data
4426# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4427 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4428# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4429 if (.not. files_loaded) then
4430# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4431 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4432# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4433 do f = 1, max_files
4434# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4435 write (file_num_str, '(I0)') f
4436# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4437 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
4438# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4439 end do
4440# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4441
4442# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4443 ! Common file reading setup
4444# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4445 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4446# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4447 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
4448# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4449
4450# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4451 select case (num_dims)
4452# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4453 case (1, 2) ! 1D and 2D cases are similar
4454# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4455 ! Count lines
4456# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4457 line_count = 0
4458# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4459 do
4460# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4461 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4462# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4463 if (ios2 /= 0) exit
4464# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4465 line_count = line_count + 1
4466# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4467 end do
4468# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4469 close (unit2)
4470# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4471
4472# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4473 xrows = line_count
4474# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4475 yrows = 1
4476# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4477 index_x = 0
4478# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4479 if (num_dims == 2) index_x = i
4480# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4481#ifdef MFC_DEBUG
4482# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4483 block
4484# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4485 use iso_fortran_env, only: output_unit
4486# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4487
4488# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4489 print *, 'm_icpp_patches.fpp:377: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4490# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4491
4492# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4493 call flush (output_unit)
4494# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4495 end block
4496# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4497#endif
4498# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4499 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4500# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4501
4502# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4503
4504# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4505
4506# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4507#if defined(MFC_OpenACC)
4508# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4509!$acc enter data create(x_coords, stored_values)
4510# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4511#elif defined(MFC_OpenMP)
4512# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4513!$omp target enter data map(always,alloc:x_coords, stored_values)
4514# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4515#endif
4516# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4517
4518# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4519 ! Read data from all files
4520# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4521 do f = 1, max_files
4522# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4523 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4524# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4525 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4526# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4527
4528# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4529 do iter = 1, xrows
4530# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4531 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4532# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4533 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
4534# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4535 end do
4536# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4537 close (unit)
4538# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4539 end do
4540# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4541
4542# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4543 ! Calculate offsets
4544# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4545 domain_xstart = x_coords(1)
4546# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4547 x_step = x_cc(1) - x_cc(0)
4548# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4549 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)
4550# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4551 global_offset_x = nint(abs(delta_x)/x_step)
4552# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4553 case (3) ! 3D case - determine grid structure
4554# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4555 ! Find yRows by counting rows with same x
4556# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4557 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4558# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4559 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4560# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4561
4562# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4563 yrows = 1
4564# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4565 do
4566# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4567 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4568# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4569 if (ios2 /= 0) exit
4570# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4571 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
4572# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4573 yrows = yrows + 1
4574# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4575 else
4576# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4577 exit
4578# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4579 end if
4580# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4581 end do
4582# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4583 close (unit2)
4584# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4585
4586# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4587 ! Count total rows
4588# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4589 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4590# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4591 nrows = 0
4592# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4593 do
4594# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4595 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4596# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4597 if (ios2 /= 0) exit
4598# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4599 nrows = nrows + 1
4600# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4601 end do
4602# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4603 close (unit2)
4604# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4605
4606# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4607 xrows = nrows/yrows
4608# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4609#ifdef MFC_DEBUG
4610# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4611 block
4612# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4613 use iso_fortran_env, only: output_unit
4614# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4615
4616# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4617 print *, 'm_icpp_patches.fpp:377: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4618# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4619
4620# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4621 call flush (output_unit)
4622# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4623 end block
4624# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4625#endif
4626# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4627 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4628# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4629
4630# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4631
4632# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4633
4634# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4635
4636# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4637#if defined(MFC_OpenACC)
4638# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4639!$acc enter data create(x_coords, y_coords, stored_values)
4640# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4641#elif defined(MFC_OpenMP)
4642# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4643!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4644# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4645#endif
4646# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4647 index_x = i
4648# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4649 index_y = j
4650# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4651
4652# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4653 ! Read all files
4654# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4655 do f = 1, max_files
4656# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4657 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4658# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4659 if (ios /= 0) then
4660# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4661 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4662# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4663 cycle
4664# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4665 end if
4666# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4667
4668# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4669 iter = 0
4670# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4671 do iix = 1, xrows
4672# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4673 do iiy = 1, yrows
4674# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4675 iter = iter + 1
4676# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4677 if (f == 1) then
4678# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4679 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4680# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4681 else
4682# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4683 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4684# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4685 end if
4686# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4687 if (ios /= 0) call s_mpi_abort("Error reading data")
4688# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4689 end do
4690# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4691 end do
4692# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4693 close (unit)
4694# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4695 end do
4696# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4697
4698# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4699 ! Calculate offsets
4700# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4701 x_step = x_cc(1) - x_cc(0)
4702# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4703 y_step = y_cc(1) - y_cc(0)
4704# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4705 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4706# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4707 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4708# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4709 global_offset_x = nint(abs(delta_x)/x_step)
4710# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4711 global_offset_y = nint(abs(delta_y)/y_step)
4712# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4713 end select
4714# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4715
4716# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4717 files_loaded = .true.
4718# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4719 end if
4720# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4721
4722# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4723 ! Data assignment
4724# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4725 select case (num_dims)
4726# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4727 case (1)
4728# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4729 idx = i + 1 + global_offset_x
4730# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4731 do f = 1, sys_size
4732# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4733 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4734# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4735 end do
4736# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4737 case (2)
4738# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4739 idx = i + 1 + global_offset_x - index_x
4740# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4741 do f = 1, sys_size - 1
4742# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4743 jump = merge(1, 0, f >= eqn_idx%mom%end)
4744# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4745 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4746# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4747 end do
4748# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4749 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4750# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4751 case (3)
4752# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4753 idx = i + 1 + global_offset_x - index_x
4754# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4755 idy = j + 1 + global_offset_y - index_y
4756# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4757 do f = 1, sys_size - 1
4758# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4759 jump = merge(1, 0, f >= eqn_idx%mom%end)
4760# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4761 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4762# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4763 end do
4764# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4765 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
4766# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4767 end select
4768# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4769 case (280) ! Isentropic vortex
4770# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4771 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
4772# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4773 ! geometry 2
4774# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4775 if (patch_id == 1) then
4776# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4777 q_prim_vf(eqn_idx%E)%sf(i, j, &
4778# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4779 & 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) &
4780# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4781 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
4782# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4783 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4784# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4785 & 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) &
4786# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4787 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
4788# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4789 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4790# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4791 & 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) &
4792# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4793 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4794# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4795 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4796# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4797 & 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) &
4798# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4799 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4800# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4801 end if
4802# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4803 case (281) ! Acoustic pulse
4804# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4805 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
4806# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4807 ! geometry 2
4808# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4809 if (patch_id == 2) then
4810# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4811 q_prim_vf(eqn_idx%E)%sf(i, j, &
4812# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4813 & 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))
4814# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4815 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4816# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4817 & 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))
4818# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4819 end if
4820# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4821 case (282) ! Zero-circulation vortex
4822# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4823 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
4824# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4825 ! geometry 2
4826# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4827 if (patch_id == 2) then
4828# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4829 q_prim_vf(eqn_idx%E)%sf(i, j, &
4830# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4831 & 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))
4832# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4833 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4834# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4835 & 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))
4836# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4837 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4838# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4839 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4840# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4841 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4842# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4843 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4844# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4845 end if
4846# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4847 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
4848# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4849 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
4850# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4851 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
4852# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4853 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
4854# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4855 ! patch_icpp(patch_id)%epsilon; defaults to 5.
4856# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4857 if (patch_id == 1) then
4858# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4859 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
4860# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4861 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
4862# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4863 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
4864# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4865 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
4866# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4867 do igq = 1, 3
4868# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4869 do jgq = 1, 3
4870# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4871 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
4872# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4873 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
4874# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4875 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
4876# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4877 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))
4878# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4879 wq = gauss_w(igq)*gauss_w(jgq)
4880# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4881 rhoq = t_facq**1.4_wp
4882# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4883 pq = t_facq**2.4_wp
4884# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4885 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4886# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4887 & - r2q)
4888# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4889 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4890# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4891 & - r2q)
4892# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4893 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
4894# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4895 rho_avg = rho_avg + wq*rhoq
4896# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4897 rhou_avg = rhou_avg + wq*(rhoq*uq)
4898# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4899 rhov_avg = rhov_avg + wq*(rhoq*vq)
4900# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4901 e_avg = e_avg + wq*eq
4902# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4903 end do
4904# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4905 end do
4906# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4907 rho_avg = rho_avg*0.25_wp
4908# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4909 rhou_avg = rhou_avg*0.25_wp
4910# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4911 rhov_avg = rhov_avg*0.25_wp
4912# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4913 e_avg = e_avg*0.25_wp
4914# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4915 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
4916# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4917 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
4918# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4919 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
4920# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4921 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
4922# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4923 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
4924# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4925 end if
4926# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4927 case (291) ! Isothermal Flat Plate
4928# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4929 t_inf = 1125.0_wp
4930# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4931 t_wall = 600.0_wp
4932# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4933 p_atm = 101325.0_wp
4934# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4935
4936# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4937 ! Boundary/Shear Layer thicknesses
4938# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4939 delta_th = 0.0003_wp ! Thermal BL thickness
4940# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4941 delta_shear = 8e-3_wp ! Velocity BL thickness
4942# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4943
4944# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4945 u_max = 50.0_wp ! Freestream Velocity (m/s)
4946# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4947
4948# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4949 mw_n2 = 28.0134e-3_wp
4950# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4951 mw_o2 = 31.999e-3_wp
4952# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4953 y_n2 = 0.767_wp
4954# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4955 y_o2 = 0.233_wp
4956# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4957 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
4958# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4959 bottom_blend_u = tanh(y_cc(j)/delta_shear)
4960# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4961 bottom_blend_t = tanh(y_cc(j)/delta_th)
4962# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4963 u_mean = u_max*bottom_blend_u
4964# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4965 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
4966# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4967 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
4968# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4969 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
4970# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4971 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4972# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4973 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
4974# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4975 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
4976# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4977 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
4978# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4979 case default
4980# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4981 if (proc_rank == 0) then
4982# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4983 call s_int_to_str(patch_id, istr)
4984# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4985 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
4986# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4987 end if
4988# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4989 end select
4990 end if
4991
4992 ! Updating the patch identities bookkeeping variable
4993 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
4994
4995 q_prim_vf(eqn_idx%alf)%sf(i, j, &
4996 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
4997 end if
4998 end do
4999 end do
5000 if (allocated(stored_values)) then
5001# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5002#ifdef MFC_DEBUG
5003# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5004 block
5005# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5006 use iso_fortran_env, only: output_unit
5007# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5008
5009# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5010 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(stored_values)'
5011# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012
5013# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 call flush (output_unit)
5015# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 end block
5017# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018#endif
5019# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020
5021# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022#if defined(MFC_OpenACC)
5023# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024!$acc exit data delete(stored_values)
5025# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026#elif defined(MFC_OpenMP)
5027# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028!$omp target exit data map(release:stored_values)
5029# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030#endif
5031# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032 deallocate (stored_values)
5033# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034#ifdef MFC_DEBUG
5035# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036 block
5037# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038 use iso_fortran_env, only: output_unit
5039# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040
5041# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(x_coords)'
5043# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044
5045# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 call flush (output_unit)
5047# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048 end block
5049# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050#endif
5051# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052
5053# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054#if defined(MFC_OpenACC)
5055# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056!$acc exit data delete(x_coords)
5057# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058#elif defined(MFC_OpenMP)
5059# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060!$omp target exit data map(release:x_coords)
5061# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062#endif
5063# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064 deallocate (x_coords)
5065# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066 end if
5067# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068
5069# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5070 if (allocated(y_coords)) then
5071# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5072#ifdef MFC_DEBUG
5073# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5074 block
5075# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5076 use iso_fortran_env, only: output_unit
5077# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5078
5079# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5080 print *, 'm_icpp_patches.fpp:388: ', '@:DEALLOCATE(y_coords)'
5081# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5082
5083# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5084 call flush (output_unit)
5085# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5086 end block
5087# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5088#endif
5089# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5090
5091# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5092#if defined(MFC_OpenACC)
5093# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5094!$acc exit data delete(y_coords)
5095# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5096#elif defined(MFC_OpenMP)
5097# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5098!$omp target exit data map(release:y_coords)
5099# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5100#endif
5101# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5102 deallocate (y_coords)
5103# 388 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5104 end if
5105
5106 end subroutine s_icpp_varcircle
5107
5108 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
5109 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
5110
5111 ! Patch identifier
5112 integer, intent(in) :: patch_id
5113
5114#ifdef MFC_MIXED_PRECISION
5115 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5116#else
5117 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
5118#endif
5119 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5120
5121 ! Generic loop iterators
5122 integer :: i, j, k
5123 real(wp) :: radius, myr, thickness
5124
5125 integer :: xRows, yRows, nRows, iix, iiy, max_files
5126# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5127 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5128# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5129 real(wp) :: x_len, x_step, y_len, y_step
5130# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5131 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5132# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5133 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
5134# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5135 real(wp) :: delta_x, delta_y
5136# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5137 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
5138# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5139 character(len=200) :: errmsg
5140# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5141 real(wp), allocatable :: stored_values(:,:,:)
5142# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5143 real(wp), allocatable :: x_coords(:), y_coords(:)
5144# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5145 logical :: files_loaded = .false.
5146# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5147 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5148# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5149 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
5150# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5151 character(len=20) :: file_num_str !< For storing the file number as a string
5152# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5153 character(len=20) :: zeros_part !< For the trailing zeros part
5154# 409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5155 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
5156 ! Place any declaration of intermediate variables here
5157# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5158 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
5159# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5160 real(wp) :: eps
5161# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5162
5163# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5164 ! IGR Jets Arrays to stor position and radii of jets from input file
5165# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5166 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
5167# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5168 ! Variables to describe initial condition of jet
5169# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5170 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
5171# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5172 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
5173# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5174 real(wp), dimension(0:n,0:p) :: rcut_arr
5175# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5176 integer :: l, q, s !< Iterators for reading input files
5177# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5178 integer :: start, end !< Ints to keep track of position in file
5179# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5180 character(len=1000) :: line !< String to store line in file
5181# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5182 character(len=25) :: value !< String to store value in line
5183# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5184 integer :: NJet !< Number of jets
5185# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5186
5187# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5188 eps = 1e-9_wp
5189# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5190
5191# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5192 if (patch_icpp(patch_id)%hcid == 303) then
5193# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5194 eps_smooth = 3._wp
5195# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5196 open (unit=10, file="njet.txt", status="old", action="read")
5197# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5198 read (10, *) njet
5199# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5200 close (10)
5201# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5202
5203# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5204 allocate (y_th_arr(0:njet - 1))
5205# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5206 allocate (z_th_arr(0:njet - 1))
5207# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5208 allocate (r_th_arr(0:njet - 1))
5209# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5210
5211# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5212 open (unit=10, file="jets.csv", status="old", action="read")
5213# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5214 do q = 0, njet - 1
5215# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5216 read (10, '(A)') line ! Read a full line as a string
5217# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5218 start = 1
5219# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5220
5221# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5222 do l = 0, 2
5223# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5224 end = index(line(start:), ',') ! Find the next comma
5225# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5226 if (end == 0) then
5227# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5228 value = trim(adjustl(line(start:))) ! Last value in the line
5229# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5230 else
5231# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5232 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
5233# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5234 start = start + end ! Move to next value
5235# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5236 end if
5237# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5238 if (l == 0) then
5239# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5240 read (value, *) y_th_arr(q) ! Convert string to numeric value
5241# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5242 else if (l == 1) then
5243# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5244 read (value, *) z_th_arr(q)
5245# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5246 else
5247# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5248 read (value, *) r_th_arr(q)
5249# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5250 end if
5251# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5252 end do
5253# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5254 end do
5255# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5256 close (10)
5257# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5258
5259# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5260 do q = 0, p
5261# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5262 do l = 0, n
5263# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5264 rcut = 0._wp
5265# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5266 do s = 0, njet - 1
5267# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5268 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
5269# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5270 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
5271# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5272 end do
5273# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5274 rcut_arr(l, q) = rcut
5275# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5276 end do
5277# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5278 end do
5279# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5280 end if
5281
5282 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
5283 x_centroid = patch_icpp(patch_id)%x_centroid
5284 y_centroid = patch_icpp(patch_id)%y_centroid
5285 z_centroid = patch_icpp(patch_id)%z_centroid
5286 length_z = patch_icpp(patch_id)%length_z
5287 radius = patch_icpp(patch_id)%radius
5288 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5289 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5290 thickness = patch_icpp(patch_id)%epsilon
5291
5292 ! Initialize eta=1; modified if smoothing is enabled
5293 eta = 1._wp
5294
5295 ! write for all z
5296
5297 ! Assign patch vars if cell is covered and patch has write permission
5298 do k = 0, p
5299 do j = 0, n
5300 do i = 0, m
5301 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
5302
5303 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
5304 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
5305 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
5306
5307
5308 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5309 select case (patch_icpp(patch_id)%hcid)
5310# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5311 case (300) ! Rayleigh-Taylor instability
5312# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5313 rhoh = 3._wp
5314# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5315 rhol = 1._wp
5316# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5317 pref = 1.e5_wp
5318# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5319 pint = pref
5320# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5321 h = 0.7_wp
5322# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5323 lam = 0.2_wp
5324# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5325 wl = 2._wp*pi/lam
5326# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5327 amp = 0.025_wp/wl
5328# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5329
5330# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5331 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
5332# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5333
5334# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5335 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5336# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5337
5338# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5339 if (alph < eps) alph = eps
5340# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5341 if (alph > 1._wp - eps) alph = 1._wp - eps
5342# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5343
5344# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5345 if (y_cc(j) > inth) then
5346# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5347 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5348# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5349 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5350# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5351 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5352# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5353 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5354# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5355 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5356# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5357 else
5358# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5359 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
5360# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5361 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
5362# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5363 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
5364# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5365 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
5366# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5367 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5368# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5369 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
5370# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5371 end if
5372# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5373 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
5374# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5375 h = 0.0_wp
5376# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5377 lam = 1.0_wp
5378# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5379 amp = patch_icpp(patch_id)%a(2)
5380# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5381 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
5382# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5383 if (x_cc(i) > inth) then
5384# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5385 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
5386# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5387 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
5388# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5389 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
5390# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5391 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
5392# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5393 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
5394# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5395 end if
5396# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5397 case (302) ! 3D Jet with IGR
5398# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5399 ux_th = 10*sqrt(1.4*0.4)
5400# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5401 ux_am = 0.0*sqrt(1.4)
5402# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5403 p_th = 2.0_wp
5404# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5405 p_am = 1.0_wp
5406# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5407 rho_th = 1._wp
5408# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5409 rho_am = 1._wp
5410# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5411 y_th = 0.0_wp
5412# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5413 z_th = 0.0_wp
5414# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5415 r_th = 1._wp
5416# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5417 eps_smooth = 1._wp
5418# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5419 eps = 1e-6
5420# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5421
5422# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5423 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
5424# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5425 rcut = f_cut_on(r - r_th, eps_smooth)
5426# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5427 xcut = f_cut_on(x_cc(i), eps_smooth)
5428# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5429
5430# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5431 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5432# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5433 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5434# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5435 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5436# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5437
5438# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5439 if (num_fluids == 1) then
5440# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5441 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5442# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5443 else
5444# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5445 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5446# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5447 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5448# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5449 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))
5450# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5451 end if
5452# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5453
5454# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5455 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5456# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5457 case (303) ! 3D Multijet
5458# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5459 eps_smooth = 3.0_wp
5460# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5461 ux_th = 10*sqrt(1.4*0.4)
5462# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5463 ux_am = 2.5*sqrt(1.4*0.4)
5464# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5465 p_th = 0.8_wp
5466# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5467 p_am = 0.4_wp
5468# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5469 rho_th = 1._wp
5470# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5471 rho_am = 1._wp
5472# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5473 eps = 1e-6
5474# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5475
5476# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5477 rcut = rcut_arr(j, k)
5478# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5479 xcut = f_cut_on(x_cc(i), eps_smooth)
5480# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5481
5482# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5483 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5484# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5485 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
5486# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5487 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
5488# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5489
5490# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5491 if (num_fluids == 1) then
5492# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5493 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5494# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5495 else
5496# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5497 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5498# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5499 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
5500# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5501 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))
5502# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5503 end if
5504# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5505
5506# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5507 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
5508# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5509 case (370) ! 3D extrusion of 2D profile from external data
5510# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5511 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
5512# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5513 if (.not. files_loaded) then
5514# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5515 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5516# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5517 do f = 1, max_files
5518# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5519 write (file_num_str, '(I0)') f
5520# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5521 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
5522# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5523 end do
5524# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5525
5526# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5527 ! Common file reading setup
5528# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5529 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5530# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5531 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5532# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5533
5534# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5535 select case (num_dims)
5536# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5537 case (1, 2) ! 1D and 2D cases are similar
5538# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5539 ! Count lines
5540# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5541 line_count = 0
5542# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5543 do
5544# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5545 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5546# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5547 if (ios2 /= 0) exit
5548# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5549 line_count = line_count + 1
5550# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5551 end do
5552# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5553 close (unit2)
5554# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5555
5556# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5557 xrows = line_count
5558# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5559 yrows = 1
5560# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5561 index_x = 0
5562# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5563 if (num_dims == 2) index_x = i
5564# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5565#ifdef MFC_DEBUG
5566# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5567 block
5568# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5569 use iso_fortran_env, only: output_unit
5570# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5571
5572# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5573 print *, 'm_icpp_patches.fpp:439: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5574# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5575
5576# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5577 call flush (output_unit)
5578# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5579 end block
5580# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5581#endif
5582# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5583 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5584# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5585
5586# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5587
5588# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5589
5590# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5591#if defined(MFC_OpenACC)
5592# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5593!$acc enter data create(x_coords, stored_values)
5594# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5595#elif defined(MFC_OpenMP)
5596# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5597!$omp target enter data map(always,alloc:x_coords, stored_values)
5598# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5599#endif
5600# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5601
5602# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5603 ! Read data from all files
5604# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5605 do f = 1, max_files
5606# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5607 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5608# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5609 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5610# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5611
5612# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5613 do iter = 1, xrows
5614# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5615 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5616# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5617 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5618# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5619 end do
5620# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5621 close (unit)
5622# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5623 end do
5624# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5625
5626# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5627 ! Calculate offsets
5628# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5629 domain_xstart = x_coords(1)
5630# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5631 x_step = x_cc(1) - x_cc(0)
5632# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5633 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)
5634# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5635 global_offset_x = nint(abs(delta_x)/x_step)
5636# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5637 case (3) ! 3D case - determine grid structure
5638# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5639 ! Find yRows by counting rows with same x
5640# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5641 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5642# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5643 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5644# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5645
5646# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5647 yrows = 1
5648# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5649 do
5650# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5651 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5652# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5653 if (ios2 /= 0) exit
5654# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5655 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5656# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5657 yrows = yrows + 1
5658# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5659 else
5660# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5661 exit
5662# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5663 end if
5664# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5665 end do
5666# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5667 close (unit2)
5668# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5669
5670# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5671 ! Count total rows
5672# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5673 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5674# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5675 nrows = 0
5676# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5677 do
5678# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5679 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5680# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5681 if (ios2 /= 0) exit
5682# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5683 nrows = nrows + 1
5684# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5685 end do
5686# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5687 close (unit2)
5688# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5689
5690# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5691 xrows = nrows/yrows
5692# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5693#ifdef MFC_DEBUG
5694# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5695 block
5696# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5697 use iso_fortran_env, only: output_unit
5698# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5699
5700# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5701 print *, 'm_icpp_patches.fpp:439: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5702# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5703
5704# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5705 call flush (output_unit)
5706# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5707 end block
5708# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5709#endif
5710# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5711 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5712# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5713
5714# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5715
5716# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5717
5718# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5719
5720# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5721#if defined(MFC_OpenACC)
5722# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5723!$acc enter data create(x_coords, y_coords, stored_values)
5724# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5725#elif defined(MFC_OpenMP)
5726# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5727!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5728# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5729#endif
5730# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5731 index_x = i
5732# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5733 index_y = j
5734# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5735
5736# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5737 ! Read all files
5738# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5739 do f = 1, max_files
5740# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5741 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5742# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5743 if (ios /= 0) then
5744# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5745 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5746# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5747 cycle
5748# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5749 end if
5750# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5751
5752# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5753 iter = 0
5754# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5755 do iix = 1, xrows
5756# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5757 do iiy = 1, yrows
5758# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5759 iter = iter + 1
5760# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5761 if (f == 1) then
5762# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5763 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5764# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5765 else
5766# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5767 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5768# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5769 end if
5770# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5771 if (ios /= 0) call s_mpi_abort("Error reading data")
5772# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5773 end do
5774# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5775 end do
5776# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5777 close (unit)
5778# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5779 end do
5780# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5781
5782# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5783 ! Calculate offsets
5784# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5785 x_step = x_cc(1) - x_cc(0)
5786# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5787 y_step = y_cc(1) - y_cc(0)
5788# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5789 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5790# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5791 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5792# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5793 global_offset_x = nint(abs(delta_x)/x_step)
5794# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5795 global_offset_y = nint(abs(delta_y)/y_step)
5796# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5797 end select
5798# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5799
5800# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5801 files_loaded = .true.
5802# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5803 end if
5804# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5805
5806# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5807 ! Data assignment
5808# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5809 select case (num_dims)
5810# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5811 case (1)
5812# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5813 idx = i + 1 + global_offset_x
5814# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5815 do f = 1, sys_size
5816# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5817 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5818# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5819 end do
5820# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5821 case (2)
5822# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5823 idx = i + 1 + global_offset_x - index_x
5824# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5825 do f = 1, sys_size - 1
5826# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5827 jump = merge(1, 0, f >= eqn_idx%mom%end)
5828# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5829 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5830# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5831 end do
5832# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5833 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5834# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5835 case (3)
5836# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5837 idx = i + 1 + global_offset_x - index_x
5838# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5839 idy = j + 1 + global_offset_y - index_y
5840# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5841 do f = 1, sys_size - 1
5842# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5843 jump = merge(1, 0, f >= eqn_idx%mom%end)
5844# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5845 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5846# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5847 end do
5848# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5849 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5850# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5851 end select
5852# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5853 case (380) ! Taylor-Green vortex
5854# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5855 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
5856# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5857 ! geometry 9
5858# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5859 mach = 0.1
5860# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5861 if (patch_id == 1) then
5862# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5863 q_prim_vf(eqn_idx%E)%sf(i, j, &
5864# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5865 & 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)
5866# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5867 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)
5868# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5869 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)
5870# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5871 end if
5872# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5873 case default
5874# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5875 call s_int_to_str(patch_id, istr)
5876# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5877 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
5878# 439 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5879 end select
5880 end if
5881
5882 ! Updating the patch identities bookkeeping variable
5883 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5884
5885 q_prim_vf(eqn_idx%alf)%sf(i, j, &
5886 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5887 end if
5888 end do
5889 end do
5890 end do
5891 if (allocated(stored_values)) then
5892# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5893#ifdef MFC_DEBUG
5894# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5895 block
5896# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5897 use iso_fortran_env, only: output_unit
5898# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5899
5900# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5901 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(stored_values)'
5902# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5903
5904# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5905 call flush (output_unit)
5906# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5907 end block
5908# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5909#endif
5910# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5911
5912# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5913#if defined(MFC_OpenACC)
5914# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5915!$acc exit data delete(stored_values)
5916# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5917#elif defined(MFC_OpenMP)
5918# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5919!$omp target exit data map(release:stored_values)
5920# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5921#endif
5922# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5923 deallocate (stored_values)
5924# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5925#ifdef MFC_DEBUG
5926# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5927 block
5928# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5929 use iso_fortran_env, only: output_unit
5930# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5931
5932# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5933 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(x_coords)'
5934# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5935
5936# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5937 call flush (output_unit)
5938# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5939 end block
5940# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5941#endif
5942# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5943
5944# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5945#if defined(MFC_OpenACC)
5946# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5947!$acc exit data delete(x_coords)
5948# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5949#elif defined(MFC_OpenMP)
5950# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5951!$omp target exit data map(release:x_coords)
5952# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5953#endif
5954# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5955 deallocate (x_coords)
5956# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5957 end if
5958# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5959
5960# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5961 if (allocated(y_coords)) then
5962# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5963#ifdef MFC_DEBUG
5964# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5965 block
5966# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5967 use iso_fortran_env, only: output_unit
5968# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5969
5970# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5971 print *, 'm_icpp_patches.fpp:451: ', '@:DEALLOCATE(y_coords)'
5972# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5973
5974# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5975 call flush (output_unit)
5976# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5977 end block
5978# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5979#endif
5980# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5981
5982# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5983#if defined(MFC_OpenACC)
5984# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5985!$acc exit data delete(y_coords)
5986# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5987#elif defined(MFC_OpenMP)
5988# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5989!$omp target exit data map(release:y_coords)
5990# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5991#endif
5992# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5993 deallocate (y_coords)
5994# 451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5995 end if
5996
5997 end subroutine s_icpp_3dvarcircle
5998
5999 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
6000 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
6001 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
6002
6003 integer, intent(in) :: patch_id
6004
6005#ifdef MFC_MIXED_PRECISION
6006 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6007#else
6008 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6009#endif
6010 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
6011 integer :: i, j, k !< Generic loop operators
6012 real(wp) :: a, b
6013
6014 integer :: xRows, yRows, nRows, iix, iiy, max_files
6015# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6016 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
6017# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6018 real(wp) :: x_len, x_step, y_len, y_step
6019# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6020 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
6021# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6022 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
6023# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6024 real(wp) :: delta_x, delta_y
6025# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
6027# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028 character(len=200) :: errmsg
6029# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030 real(wp), allocatable :: stored_values(:,:,:)
6031# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 real(wp), allocatable :: x_coords(:), y_coords(:)
6033# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034 logical :: files_loaded = .false.
6035# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6036 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
6037# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6038 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
6039# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 character(len=20) :: file_num_str !< For storing the file number as a string
6041# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 character(len=20) :: zeros_part !< For the trailing zeros part
6043# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
6045 ! Place any declaration of intermediate variables here
6046# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6047 real(wp) :: eps, eps_mhd, C_mhd
6048# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6049 real(wp) :: r, rmax, gam, umax, p0
6050# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6051 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
6052# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6053 real(wp) :: factor
6054# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6055 real(wp) :: r0, alpha, r2
6056# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6057 real(wp) :: sinA, cosA
6058# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6059 real(wp) :: r_sq
6060# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6061
6062# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6063 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
6064# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6065 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
6066# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6067 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
6068# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6069 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
6070# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6071 integer :: igq, jgq
6072# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6073
6074# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6075 ! # 291 - Shear/Thermal Layer Case
6076# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6077 real(wp) :: delta_shear, u_max, u_mean
6078# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6079 real(wp) :: T_wall, T_inf, P_atm, T_loc
6080# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6081 real(wp) :: delta_th, R_mix
6082# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6083 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
6084# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6085 real(wp) :: bottom_blend_u, bottom_blend_T
6086# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6087
6088# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6089 ! # 207
6090# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6091 real(wp) :: sigma, gauss1, gauss2
6092# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6093
6094# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6095 ! # 208
6096# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6097 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
6098# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6099
6100# 471 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6101 eps = 1.e-9_wp
6102
6103 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
6104 x_centroid = patch_icpp(patch_id)%x_centroid
6105 y_centroid = patch_icpp(patch_id)%y_centroid
6106 a = patch_icpp(patch_id)%radii(1)
6107 b = patch_icpp(patch_id)%radii(2)
6108 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
6109 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
6110
6111 ! Initialize eta=1; modified if smoothing is enabled
6112 eta = 1._wp
6113
6114 ! Assign patch vars if cell is covered and patch has write permission
6115 do j = 0, n
6116 do i = 0, m
6117 if (patch_icpp(patch_id)%smoothen) then
6118 eta = tanh(smooth_coeff/min(dx, &
6119 & dy)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
6120 & + 0.5_wp
6121 end if
6122
6123 if ((((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp &
6124 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
6125 & 0) == smooth_patch_id) then
6126 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
6127
6128
6129 if (patch_icpp(patch_id)%hcid /= dflt_int) then
6130 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
6131# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6132 case (200) ! Two-fluid cubic interface
6133# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6134 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
6135# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6136 ! Volume Fractions
6137# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6138 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
6139# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6140 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
6141# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
6143# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
6145# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
6147# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6148 end if
6149# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6150 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
6151# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6153# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 rmax = 0.2_wp
6155# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156
6157# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6159# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6161# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6163# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164
6165# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166 if (r < rmax) then
6167# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6169# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6171# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6173# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174 else if (r < 2*rmax) then
6175# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6177# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6179# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 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)))
6181# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 else
6183# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6185# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6187# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
6189# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 end if
6191# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
6193# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6195# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196 rmax = 0.2_wp
6197# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198
6199# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6201# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6203# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6205# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206
6207# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208 if (r < rmax) then
6209# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6211# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6213# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6215# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216 else if (r < 2*rmax) then
6217# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6219# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6221# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222 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)))
6223# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224 else
6225# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
6227# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
6229# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
6231# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232 end if
6233# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234
6235# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
6237# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238 case (204) ! Rayleigh-Taylor instability
6239# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 rhoh = 3._wp
6241# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 rhol = 1._wp
6243# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244 pref = 1.e5_wp
6245# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 pint = pref
6247# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248 h = 0.7_wp
6249# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 lam = 0.2_wp
6251# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252 wl = 2._wp*pi/lam
6253# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254 amp = 0.05_wp/wl
6255# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256
6257# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
6259# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260
6261# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6263# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264
6265# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266 if (alph < eps) alph = eps
6267# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268 if (alph > 1._wp - eps) alph = 1._wp - eps
6269# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270
6271# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 if (y_cc(j) > inth) then
6273# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6275# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6277# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6279# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6281# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6283# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284 else
6285# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
6287# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
6289# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
6291# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
6293# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6295# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
6297# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 end if
6299# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300 case (205) ! 2D lung wave interaction problem
6301# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 h = 0.0_wp ! non dim origin y
6303# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 lam = 1.0_wp ! non dim lambda
6305# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
6307# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308
6309# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
6311# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312
6313# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 if (y_cc(j) > inth) then
6315# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6317# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6319# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6321# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6323# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6325# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326 end if
6327# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 case (206) ! 2D lung wave interaction problem - horizontal domain
6329# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330 h = 0.0_wp ! non dim origin y
6331# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332 lam = 1.0_wp ! non dim lambda
6333# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334 amp = patch_icpp(patch_id)%a(2)
6335# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6336
6337# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6338 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
6339# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340
6341# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6342 if (x_cc(i) > intl) then ! this is the liquid
6343# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6344 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6345# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6347# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6349# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6351# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6353# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 end if
6355# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356 case (207) ! Kelvin Helmholtz Instability
6357# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358 sigma = 0.05_wp/sqrt(2.0_wp)
6359# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
6361# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
6363# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364 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)
6365# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 case (208) ! Richtmeyer Meshkov Instability
6367# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 lam = 1.0_wp
6369# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370 eps = 1.0e-6_wp
6371# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 ei = 5.0_wp
6373# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374 ! Smoothening function to smooth out sharp discontinuity in the interface
6375# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 if (x_cc(i) <= 0.7_wp*lam) then
6377# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
6379# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
6381# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
6383# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 alpha_sf6 = 1.0_wp - alpha_air
6385# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
6387# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
6389# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
6391# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
6393# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 end if
6395# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396 case (250) ! MHD Orszag-Tang vortex
6397# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 ! 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),
6399# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 ! sin(4*pi*x)/sqrt(4*pi), 0)
6401# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6402
6403# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6404 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
6405# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
6407# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408
6409# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
6411# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
6413# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
6415# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
6417# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
6419# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
6421# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
6423# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424 ! Linear interpolation between r=0.08 and r=1.0
6425# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
6427# 500 "/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_wp*factor + 1.e-4_wp*(1.0_wp - factor)
6429# 500 "/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_wp*factor + 3.e-5_wp*(1.0_wp - factor)
6431# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 else
6433# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
6435# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6436 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
6437# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 end if
6439# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440
6441# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442 ! case 252 is for the 2D MHD Rotor problem
6443# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 case (252) ! 2D MHD Rotor Problem
6445# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
6447# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 !
6449# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450 ! 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
6451# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6452 ! velocity w=20, giving v_tan=2 at r=0.1
6453# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6454
6455# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 ! Calculate distance squared from the center
6457# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
6459# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460
6461# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462 ! inner radius of 0.1
6463# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464 if (r_sq <= 0.1**2) then
6465# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 ! -- Inside the rotor -- Set density uniformly to 10
6467# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
6469# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470
6471# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
6473# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
6475# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
6477# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478
6479# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480 ! taper width of 0.015
6481# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 else if (r_sq <= 0.115**2) then
6483# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484 ! linearly smooth the function between r = 0.1 and 0.115
6485# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6487# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488
6489# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 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)
6491# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 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)
6493# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494 end if
6495# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 case (253) ! MHD Smooth Magnetic Vortex
6497# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
6499# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
6501# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502
6503# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6504 ! velocity
6505# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6506 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))
6507# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508 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))
6509# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510
6511# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512 ! magnetic field
6513# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514 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)
6515# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516 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)
6517# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518
6519# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520 ! pressure
6521# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522 q_prim_vf(eqn_idx%E)%sf(i, j, &
6523# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524 & 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)
6525# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526 case (260) ! Gaussian Divergence Pulse
6527# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
6529# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
6531# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532 ! initialized to zero everywhere.
6533# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534
6535# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536 eps_mhd = patch_icpp(patch_id)%a(2)
6537# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 sigma = patch_icpp(patch_id)%a(3)
6539# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
6541# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542
6543# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544 ! B-field
6545# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6547# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6548 case (261) ! Blob
6549# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6550 r0 = 1._wp/sqrt(8._wp)
6551# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552 r2 = x_cc(i)**2 + y_cc(j)**2
6553# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6554 r = sqrt(r2)
6555# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6556 alpha = r/r0
6557# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558 if (alpha < 1) then
6559# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 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)
6561# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 ! 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)
6563# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
6565# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 ! 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
6567# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568 end if
6569# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
6571# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 ! rotate by \alpha = atan(2)
6573# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574 alpha = atan(2._wp)
6575# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 cosa = cos(alpha)
6577# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578 sina = sin(alpha)
6579# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580 ! projection along shock normal
6581# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 r = x_cc(i)*cosa + y_cc(j)*sina
6583# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584
6585# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586 if (r <= 0.5_wp) then
6587# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
6589# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6591# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
6593# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6594 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
6595# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6596 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
6597# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598 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
6599# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600 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
6601# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602 else
6603# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
6605# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
6607# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
6609# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
6611# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
6613# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614 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
6615# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 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
6617# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618 end if
6619# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 ! v^z and B^z remain zero by default
6621# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622 case (270) ! 2D extrusion of 1D profile from external data
6623# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6625# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 if (.not. files_loaded) then
6627# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6629# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 do f = 1, max_files
6631# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632 write (file_num_str, '(I0)') f
6633# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
6635# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 end do
6637# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638
6639# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 ! Common file reading setup
6641# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6643# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6645# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646
6647# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648 select case (num_dims)
6649# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650 case (1, 2) ! 1D and 2D cases are similar
6651# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652 ! Count lines
6653# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654 line_count = 0
6655# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656 do
6657# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6659# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 if (ios2 /= 0) exit
6661# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 line_count = line_count + 1
6663# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664 end do
6665# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 close (unit2)
6667# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668
6669# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 xrows = line_count
6671# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672 yrows = 1
6673# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 index_x = 0
6675# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 if (num_dims == 2) index_x = i
6677# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678#ifdef MFC_DEBUG
6679# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 block
6681# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 use iso_fortran_env, only: output_unit
6683# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684
6685# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 print *, 'm_icpp_patches.fpp:500: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6687# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688
6689# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 call flush (output_unit)
6691# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 end block
6693# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694#endif
6695# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6697# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698
6699# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700
6701# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702
6703# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704#if defined(MFC_OpenACC)
6705# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706!$acc enter data create(x_coords, stored_values)
6707# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708#elif defined(MFC_OpenMP)
6709# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710!$omp target enter data map(always,alloc:x_coords, stored_values)
6711# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712#endif
6713# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714
6715# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716 ! Read data from all files
6717# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718 do f = 1, max_files
6719# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6721# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6723# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724
6725# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726 do iter = 1, xrows
6727# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6729# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6731# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732 end do
6733# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734 close (unit)
6735# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736 end do
6737# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738
6739# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 ! Calculate offsets
6741# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 domain_xstart = x_coords(1)
6743# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 x_step = x_cc(1) - x_cc(0)
6745# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 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)
6747# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 global_offset_x = nint(abs(delta_x)/x_step)
6749# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 case (3) ! 3D case - determine grid structure
6751# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 ! Find yRows by counting rows with same x
6753# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6755# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6757# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758
6759# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 yrows = 1
6761# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 do
6763# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6765# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 if (ios2 /= 0) exit
6767# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6769# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 yrows = yrows + 1
6771# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 else
6773# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 exit
6775# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 end if
6777# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 end do
6779# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 close (unit2)
6781# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782
6783# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 ! Count total rows
6785# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6787# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 nrows = 0
6789# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 do
6791# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6793# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 if (ios2 /= 0) exit
6795# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 nrows = nrows + 1
6797# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 end do
6799# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 close (unit2)
6801# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802
6803# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 xrows = nrows/yrows
6805# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806#ifdef MFC_DEBUG
6807# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808 block
6809# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 use iso_fortran_env, only: output_unit
6811# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812
6813# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 print *, 'm_icpp_patches.fpp:500: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6815# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816
6817# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 call flush (output_unit)
6819# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6820 end block
6821# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6822#endif
6823# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6824 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6825# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6826
6827# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6828
6829# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6830
6831# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6832
6833# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6834#if defined(MFC_OpenACC)
6835# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6836!$acc enter data create(x_coords, y_coords, stored_values)
6837# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6838#elif defined(MFC_OpenMP)
6839# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6840!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6841# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6842#endif
6843# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6844 index_x = i
6845# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6846 index_y = j
6847# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6848
6849# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6850 ! Read all files
6851# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6852 do f = 1, max_files
6853# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6854 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6855# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6856 if (ios /= 0) then
6857# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6858 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6859# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6860 cycle
6861# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6862 end if
6863# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6864
6865# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6866 iter = 0
6867# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6868 do iix = 1, xrows
6869# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6870 do iiy = 1, yrows
6871# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6872 iter = iter + 1
6873# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6874 if (f == 1) then
6875# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6876 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6877# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6878 else
6879# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6880 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6881# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6882 end if
6883# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6884 if (ios /= 0) call s_mpi_abort("Error reading data")
6885# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6886 end do
6887# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6888 end do
6889# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6890 close (unit)
6891# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6892 end do
6893# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6894
6895# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6896 ! Calculate offsets
6897# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6898 x_step = x_cc(1) - x_cc(0)
6899# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6900 y_step = y_cc(1) - y_cc(0)
6901# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6902 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6903# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6904 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6905# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6906 global_offset_x = nint(abs(delta_x)/x_step)
6907# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6908 global_offset_y = nint(abs(delta_y)/y_step)
6909# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6910 end select
6911# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6912
6913# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6914 files_loaded = .true.
6915# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6916 end if
6917# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6918
6919# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6920 ! Data assignment
6921# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6922 select case (num_dims)
6923# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6924 case (1)
6925# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6926 idx = i + 1 + global_offset_x
6927# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6928 do f = 1, sys_size
6929# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6930 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6931# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6932 end do
6933# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6934 case (2)
6935# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6936 idx = i + 1 + global_offset_x - index_x
6937# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6938 do f = 1, sys_size - 1
6939# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6940 jump = merge(1, 0, f >= eqn_idx%mom%end)
6941# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6942 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6943# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6944 end do
6945# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6946 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6947# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6948 case (3)
6949# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6950 idx = i + 1 + global_offset_x - index_x
6951# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6952 idy = j + 1 + global_offset_y - index_y
6953# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6954 do f = 1, sys_size - 1
6955# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6956 jump = merge(1, 0, f >= eqn_idx%mom%end)
6957# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6958 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6959# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6960 end do
6961# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6962 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6963# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6964 end select
6965# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6966 case (280) ! Isentropic vortex
6967# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6968 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6969# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6970 ! geometry 2
6971# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6972 if (patch_id == 1) then
6973# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6974 q_prim_vf(eqn_idx%E)%sf(i, j, &
6975# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6976 & 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) &
6977# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6978 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6979# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6980 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6981# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6982 & 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) &
6983# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6984 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6985# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6986 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6987# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6988 & 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) &
6989# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6990 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6991# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6992 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
6993# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6994 & 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) &
6995# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6997# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998 end if
6999# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000 case (281) ! Acoustic pulse
7001# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
7003# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004 ! geometry 2
7005# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006 if (patch_id == 2) then
7007# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008 q_prim_vf(eqn_idx%E)%sf(i, j, &
7009# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010 & 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))
7011# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7013# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014 & 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))
7015# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 end if
7017# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018 case (282) ! Zero-circulation vortex
7019# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
7021# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022 ! geometry 2
7023# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024 if (patch_id == 2) then
7025# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 q_prim_vf(eqn_idx%E)%sf(i, j, &
7027# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028 & 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))
7029# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7031# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032 & 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))
7033# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
7035# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7037# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7039# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7041# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042 end if
7043# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
7045# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
7047# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7048 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
7049# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7050 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
7051# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7052 ! patch_icpp(patch_id)%epsilon; defaults to 5.
7053# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7054 if (patch_id == 1) then
7055# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7056 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
7057# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7058 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
7059# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7060 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
7061# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7062 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
7063# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7064 do igq = 1, 3
7065# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7066 do jgq = 1, 3
7067# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7068 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
7069# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7070 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
7071# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7072 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
7073# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7074 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))
7075# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7076 wq = gauss_w(igq)*gauss_w(jgq)
7077# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7078 rhoq = t_facq**1.4_wp
7079# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7080 pq = t_facq**2.4_wp
7081# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7082 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7083# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7084 & - r2q)
7085# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7086 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7087# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7088 & - r2q)
7089# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7090 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
7091# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7092 rho_avg = rho_avg + wq*rhoq
7093# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7094 rhou_avg = rhou_avg + wq*(rhoq*uq)
7095# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7096 rhov_avg = rhov_avg + wq*(rhoq*vq)
7097# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7098 e_avg = e_avg + wq*eq
7099# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7100 end do
7101# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7102 end do
7103# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7104 rho_avg = rho_avg*0.25_wp
7105# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7106 rhou_avg = rhou_avg*0.25_wp
7107# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7108 rhov_avg = rhov_avg*0.25_wp
7109# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7110 e_avg = e_avg*0.25_wp
7111# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7112 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
7113# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7114 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
7115# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7116 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
7117# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7118 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
7119# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7120 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
7121# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7122 end if
7123# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7124 case (291) ! Isothermal Flat Plate
7125# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7126 t_inf = 1125.0_wp
7127# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7128 t_wall = 600.0_wp
7129# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7130 p_atm = 101325.0_wp
7131# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7132
7133# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7134 ! Boundary/Shear Layer thicknesses
7135# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7136 delta_th = 0.0003_wp ! Thermal BL thickness
7137# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7138 delta_shear = 8e-3_wp ! Velocity BL thickness
7139# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7140
7141# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7142 u_max = 50.0_wp ! Freestream Velocity (m/s)
7143# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7144
7145# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7146 mw_n2 = 28.0134e-3_wp
7147# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7148 mw_o2 = 31.999e-3_wp
7149# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7150 y_n2 = 0.767_wp
7151# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7152 y_o2 = 0.233_wp
7153# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7154 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
7155# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7156 bottom_blend_u = tanh(y_cc(j)/delta_shear)
7157# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7158 bottom_blend_t = tanh(y_cc(j)/delta_th)
7159# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7160 u_mean = u_max*bottom_blend_u
7161# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7162 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
7163# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7164 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
7165# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7166 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
7167# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7168 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
7169# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7170 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
7171# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7172 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
7173# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7174 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
7175# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7176 case default
7177# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7178 if (proc_rank == 0) then
7179# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7180 call s_int_to_str(patch_id, istr)
7181# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7182 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
7183# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7184 end if
7185# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7186 end select
7187 end if
7188
7189 ! Updating the patch identities bookkeeping variable
7190 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
7191 end if
7192 end do
7193 end do
7194 if (allocated(stored_values)) then
7195# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7196#ifdef MFC_DEBUG
7197# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7198 block
7199# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7200 use iso_fortran_env, only: output_unit
7201# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7202
7203# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7204 print *, 'm_icpp_patches.fpp:508: ', '@:DEALLOCATE(stored_values)'
7205# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7206
7207# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7208 call flush (output_unit)
7209# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7210 end block
7211# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7212#endif
7213# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7214
7215# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7216#if defined(MFC_OpenACC)
7217# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7218!$acc exit data delete(stored_values)
7219# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7220#elif defined(MFC_OpenMP)
7221# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7222!$omp target exit data map(release:stored_values)
7223# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7224#endif
7225# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7226 deallocate (stored_values)
7227# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7228#ifdef MFC_DEBUG
7229# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7230 block
7231# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7232 use iso_fortran_env, only: output_unit
7233# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7234
7235# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7236 print *, 'm_icpp_patches.fpp:508: ', '@:DEALLOCATE(x_coords)'
7237# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7238
7239# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7240 call flush (output_unit)
7241# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7242 end block
7243# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7244#endif
7245# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7246
7247# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7248#if defined(MFC_OpenACC)
7249# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7250!$acc exit data delete(x_coords)
7251# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7252#elif defined(MFC_OpenMP)
7253# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7254!$omp target exit data map(release:x_coords)
7255# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7256#endif
7257# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7258 deallocate (x_coords)
7259# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7260 end if
7261# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7262
7263# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7264 if (allocated(y_coords)) then
7265# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7266#ifdef MFC_DEBUG
7267# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7268 block
7269# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7270 use iso_fortran_env, only: output_unit
7271# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7272
7273# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7274 print *, 'm_icpp_patches.fpp:508: ', '@:DEALLOCATE(y_coords)'
7275# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7276
7277# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7278 call flush (output_unit)
7279# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7280 end block
7281# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7282#endif
7283# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7284
7285# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7286#if defined(MFC_OpenACC)
7287# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7288!$acc exit data delete(y_coords)
7289# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7290#elif defined(MFC_OpenMP)
7291# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7292!$omp target exit data map(release:y_coords)
7293# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7294#endif
7295# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7296 deallocate (y_coords)
7297# 508 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7298 end if
7299
7300 end subroutine s_icpp_ellipse
7301
7302 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
7303 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
7304 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
7305
7306 ! Patch identifier
7307 integer, intent(in) :: patch_id
7308
7309#ifdef MFC_MIXED_PRECISION
7310 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7311#else
7312 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7313#endif
7314 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7315
7316 ! Generic loop iterators
7317 integer :: i, j, k
7318 real(wp) :: a, b, c
7319
7320 integer :: xRows, yRows, nRows, iix, iiy, max_files
7321# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7322 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7323# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7324 real(wp) :: x_len, x_step, y_len, y_step
7325# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7326 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7327# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7328 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7329# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7330 real(wp) :: delta_x, delta_y
7331# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7332 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7333# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7334 character(len=200) :: errmsg
7335# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7336 real(wp), allocatable :: stored_values(:,:,:)
7337# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7338 real(wp), allocatable :: x_coords(:), y_coords(:)
7339# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7340 logical :: files_loaded = .false.
7341# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7342 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7343# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7344 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
7345# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7346 character(len=20) :: file_num_str !< For storing the file number as a string
7347# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7348 character(len=20) :: zeros_part !< For the trailing zeros part
7349# 530 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7350 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
7351 ! Place any declaration of intermediate variables here
7352# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7353 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
7354# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7355 real(wp) :: eps
7356# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7357
7358# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7359 ! IGR Jets Arrays to stor position and radii of jets from input file
7360# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7361 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
7362# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7363 ! Variables to describe initial condition of jet
7364# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7365 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
7366# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7367 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
7368# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7369 real(wp), dimension(0:n,0:p) :: rcut_arr
7370# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7371 integer :: l, q, s !< Iterators for reading input files
7372# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7373 integer :: start, end !< Ints to keep track of position in file
7374# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7375 character(len=1000) :: line !< String to store line in file
7376# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7377 character(len=25) :: value !< String to store value in line
7378# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7379 integer :: NJet !< Number of jets
7380# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7381
7382# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7383 eps = 1e-9_wp
7384# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7385
7386# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7387 if (patch_icpp(patch_id)%hcid == 303) then
7388# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7389 eps_smooth = 3._wp
7390# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7391 open (unit=10, file="njet.txt", status="old", action="read")
7392# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7393 read (10, *) njet
7394# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7395 close (10)
7396# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7397
7398# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7399 allocate (y_th_arr(0:njet - 1))
7400# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7401 allocate (z_th_arr(0:njet - 1))
7402# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7403 allocate (r_th_arr(0:njet - 1))
7404# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7405
7406# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7407 open (unit=10, file="jets.csv", status="old", action="read")
7408# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7409 do q = 0, njet - 1
7410# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7411 read (10, '(A)') line ! Read a full line as a string
7412# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7413 start = 1
7414# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7415
7416# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7417 do l = 0, 2
7418# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7419 end = index(line(start:), ',') ! Find the next comma
7420# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7421 if (end == 0) then
7422# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7423 value = trim(adjustl(line(start:))) ! Last value in the line
7424# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7425 else
7426# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7427 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
7428# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7429 start = start + end ! Move to next value
7430# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7431 end if
7432# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7433 if (l == 0) then
7434# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7435 read (value, *) y_th_arr(q) ! Convert string to numeric value
7436# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7437 else if (l == 1) then
7438# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7439 read (value, *) z_th_arr(q)
7440# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7441 else
7442# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7443 read (value, *) r_th_arr(q)
7444# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7445 end if
7446# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7447 end do
7448# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7449 end do
7450# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7451 close (10)
7452# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7453
7454# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7455 do q = 0, p
7456# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7457 do l = 0, n
7458# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7459 rcut = 0._wp
7460# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7461 do s = 0, njet - 1
7462# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7463 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
7464# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7465 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
7466# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7467 end do
7468# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7469 rcut_arr(l, q) = rcut
7470# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7471 end do
7472# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7473 end do
7474# 531 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7475 end if
7476
7477 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
7478 x_centroid = patch_icpp(patch_id)%x_centroid
7479 y_centroid = patch_icpp(patch_id)%y_centroid
7480 z_centroid = patch_icpp(patch_id)%z_centroid
7481 a = patch_icpp(patch_id)%radii(1)
7482 b = patch_icpp(patch_id)%radii(2)
7483 c = patch_icpp(patch_id)%radii(3)
7484 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7485 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7486
7487 ! Initialize eta=1; modified if smoothing is enabled
7488 eta = 1._wp
7489
7490 ! Assign patch vars if cell is covered and patch has write permission
7491 do k = 0, p
7492 do j = 0, n
7493 do i = 0, m
7494 if (grid_geometry == 3) then
7495 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
7496 else
7497 cart_y = y_cc(j)
7498 cart_z = z_cc(k)
7499 end if
7500
7501 if (patch_icpp(patch_id)%smoothen) then
7502 eta = tanh(smooth_coeff/min(dx, dy, &
7503 & dz)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
7504 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
7505 end if
7506
7507 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp &
7508 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
7509 & k) == smooth_patch_id) then
7510 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
7511
7512
7513 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7514 select case (patch_icpp(patch_id)%hcid)
7515# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7516 case (300) ! Rayleigh-Taylor instability
7517# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7518 rhoh = 3._wp
7519# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7520 rhol = 1._wp
7521# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7522 pref = 1.e5_wp
7523# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7524 pint = pref
7525# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7526 h = 0.7_wp
7527# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7528 lam = 0.2_wp
7529# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7530 wl = 2._wp*pi/lam
7531# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7532 amp = 0.025_wp/wl
7533# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7534
7535# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7536 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
7537# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7538
7539# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7540 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7541# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7542
7543# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7544 if (alph < eps) alph = eps
7545# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7546 if (alph > 1._wp - eps) alph = 1._wp - eps
7547# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7548
7549# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7550 if (y_cc(j) > inth) then
7551# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7552 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7553# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7554 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7555# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7556 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7557# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7558 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7559# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7560 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7561# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7562 else
7563# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7564 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
7565# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7566 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
7567# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7568 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
7569# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7570 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
7571# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7573# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
7575# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576 end if
7577# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
7579# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 h = 0.0_wp
7581# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582 lam = 1.0_wp
7583# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584 amp = patch_icpp(patch_id)%a(2)
7585# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
7587# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588 if (x_cc(i) > inth) then
7589# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
7591# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
7593# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
7595# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
7597# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
7599# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7600 end if
7601# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7602 case (302) ! 3D Jet with IGR
7603# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7604 ux_th = 10*sqrt(1.4*0.4)
7605# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7606 ux_am = 0.0*sqrt(1.4)
7607# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7608 p_th = 2.0_wp
7609# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7610 p_am = 1.0_wp
7611# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7612 rho_th = 1._wp
7613# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7614 rho_am = 1._wp
7615# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7616 y_th = 0.0_wp
7617# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7618 z_th = 0.0_wp
7619# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7620 r_th = 1._wp
7621# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7622 eps_smooth = 1._wp
7623# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7624 eps = 1e-6
7625# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7626
7627# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7628 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
7629# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7630 rcut = f_cut_on(r - r_th, eps_smooth)
7631# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 xcut = f_cut_on(x_cc(i), eps_smooth)
7633# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634
7635# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7637# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7639# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7641# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642
7643# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644 if (num_fluids == 1) then
7645# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7647# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 else
7649# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7651# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7653# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 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))
7655# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656 end if
7657# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658
7659# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7661# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 case (303) ! 3D Multijet
7663# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664 eps_smooth = 3.0_wp
7665# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 ux_th = 10*sqrt(1.4*0.4)
7667# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668 ux_am = 2.5*sqrt(1.4*0.4)
7669# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670 p_th = 0.8_wp
7671# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 p_am = 0.4_wp
7673# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674 rho_th = 1._wp
7675# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 rho_am = 1._wp
7677# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 eps = 1e-6
7679# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680
7681# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 rcut = rcut_arr(j, k)
7683# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 xcut = f_cut_on(x_cc(i), eps_smooth)
7685# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686
7687# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7689# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
7691# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
7693# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694
7695# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696 if (num_fluids == 1) then
7697# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7699# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700 else
7701# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7703# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
7705# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706 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))
7707# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708 end if
7709# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710
7711# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
7713# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714 case (370) ! 3D extrusion of 2D profile from external data
7715# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7717# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718 if (.not. files_loaded) then
7719# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7721# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722 do f = 1, max_files
7723# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724 write (file_num_str, '(I0)') f
7725# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
7727# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728 end do
7729# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730
7731# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732 ! Common file reading setup
7733# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7735# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7737# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738
7739# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740 select case (num_dims)
7741# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 case (1, 2) ! 1D and 2D cases are similar
7743# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 ! Count lines
7745# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 line_count = 0
7747# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748 do
7749# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7751# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752 if (ios2 /= 0) exit
7753# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754 line_count = line_count + 1
7755# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756 end do
7757# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 close (unit2)
7759# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760
7761# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 xrows = line_count
7763# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764 yrows = 1
7765# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 index_x = 0
7767# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 if (num_dims == 2) index_x = i
7769# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770#ifdef MFC_DEBUG
7771# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 block
7773# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 use iso_fortran_env, only: output_unit
7775# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776
7777# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 print *, 'm_icpp_patches.fpp:570: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7779# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780
7781# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782 call flush (output_unit)
7783# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 end block
7785# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786#endif
7787# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7789# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790
7791# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792
7793# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794
7795# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796#if defined(MFC_OpenACC)
7797# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798!$acc enter data create(x_coords, stored_values)
7799# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800#elif defined(MFC_OpenMP)
7801# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802!$omp target enter data map(always,alloc:x_coords, stored_values)
7803# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804#endif
7805# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806
7807# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808 ! Read data from all files
7809# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810 do f = 1, max_files
7811# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7813# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7815# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816
7817# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 do iter = 1, xrows
7819# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7821# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
7823# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 end do
7825# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826 close (unit)
7827# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 end do
7829# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830
7831# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 ! Calculate offsets
7833# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 domain_xstart = x_coords(1)
7835# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836 x_step = x_cc(1) - x_cc(0)
7837# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838 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)
7839# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840 global_offset_x = nint(abs(delta_x)/x_step)
7841# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842 case (3) ! 3D case - determine grid structure
7843# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 ! Find yRows by counting rows with same x
7845# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7847# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7849# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850
7851# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 yrows = 1
7853# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854 do
7855# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7857# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858 if (ios2 /= 0) exit
7859# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
7861# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862 yrows = yrows + 1
7863# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 else
7865# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 exit
7867# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 end if
7869# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870 end do
7871# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 close (unit2)
7873# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874
7875# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 ! Count total rows
7877# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7879# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880 nrows = 0
7881# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 do
7883# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7885# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886 if (ios2 /= 0) exit
7887# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 nrows = nrows + 1
7889# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890 end do
7891# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7892 close (unit2)
7893# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7894
7895# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7896 xrows = nrows/yrows
7897# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7898#ifdef MFC_DEBUG
7899# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7900 block
7901# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7902 use iso_fortran_env, only: output_unit
7903# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7904
7905# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7906 print *, 'm_icpp_patches.fpp:570: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7907# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7908
7909# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7910 call flush (output_unit)
7911# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7912 end block
7913# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7914#endif
7915# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7916 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7917# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7918
7919# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7920
7921# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7922
7923# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7924
7925# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7926#if defined(MFC_OpenACC)
7927# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7928!$acc enter data create(x_coords, y_coords, stored_values)
7929# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7930#elif defined(MFC_OpenMP)
7931# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7932!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7933# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7934#endif
7935# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7936 index_x = i
7937# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7938 index_y = j
7939# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7940
7941# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7942 ! Read all files
7943# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7944 do f = 1, max_files
7945# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7946 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7947# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7948 if (ios /= 0) then
7949# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7950 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7951# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7952 cycle
7953# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7954 end if
7955# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7956
7957# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7958 iter = 0
7959# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7960 do iix = 1, xrows
7961# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7962 do iiy = 1, yrows
7963# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7964 iter = iter + 1
7965# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7966 if (f == 1) then
7967# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7968 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7969# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7970 else
7971# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7972 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7973# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7974 end if
7975# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7976 if (ios /= 0) call s_mpi_abort("Error reading data")
7977# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7978 end do
7979# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7980 end do
7981# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7982 close (unit)
7983# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7984 end do
7985# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7986
7987# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7988 ! Calculate offsets
7989# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7990 x_step = x_cc(1) - x_cc(0)
7991# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7992 y_step = y_cc(1) - y_cc(0)
7993# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7994 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
7995# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7996 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
7997# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7998 global_offset_x = nint(abs(delta_x)/x_step)
7999# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8000 global_offset_y = nint(abs(delta_y)/y_step)
8001# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8002 end select
8003# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8004
8005# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8006 files_loaded = .true.
8007# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8008 end if
8009# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8010
8011# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8012 ! Data assignment
8013# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8014 select case (num_dims)
8015# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8016 case (1)
8017# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8018 idx = i + 1 + global_offset_x
8019# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8020 do f = 1, sys_size
8021# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8022 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8023# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8024 end do
8025# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8026 case (2)
8027# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8028 idx = i + 1 + global_offset_x - index_x
8029# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8030 do f = 1, sys_size - 1
8031# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8032 jump = merge(1, 0, f >= eqn_idx%mom%end)
8033# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8034 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8035# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 end do
8037# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8039# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040 case (3)
8041# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042 idx = i + 1 + global_offset_x - index_x
8043# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044 idy = j + 1 + global_offset_y - index_y
8045# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046 do f = 1, sys_size - 1
8047# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048 jump = merge(1, 0, f >= eqn_idx%mom%end)
8049# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8051# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052 end do
8053# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8055# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056 end select
8057# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058 case (380) ! Taylor-Green vortex
8059# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
8061# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8062 ! geometry 9
8063# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8064 mach = 0.1
8065# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8066 if (patch_id == 1) then
8067# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8068 q_prim_vf(eqn_idx%E)%sf(i, j, &
8069# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8070 & 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)
8071# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8072 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)
8073# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8074 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)
8075# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8076 end if
8077# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8078 case default
8079# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8080 call s_int_to_str(patch_id, istr)
8081# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8082 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
8083# 570 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8084 end select
8085 end if
8086
8087 ! Updating the patch identities bookkeeping variable
8088 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
8089 end if
8090 end do
8091 end do
8092 end do
8093 if (allocated(stored_values)) then
8094# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8095#ifdef MFC_DEBUG
8096# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8097 block
8098# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8099 use iso_fortran_env, only: output_unit
8100# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8101
8102# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8103 print *, 'm_icpp_patches.fpp:579: ', '@:DEALLOCATE(stored_values)'
8104# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8105
8106# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8107 call flush (output_unit)
8108# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8109 end block
8110# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8111#endif
8112# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8113
8114# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8115#if defined(MFC_OpenACC)
8116# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8117!$acc exit data delete(stored_values)
8118# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8119#elif defined(MFC_OpenMP)
8120# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8121!$omp target exit data map(release:stored_values)
8122# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8123#endif
8124# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8125 deallocate (stored_values)
8126# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8127#ifdef MFC_DEBUG
8128# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8129 block
8130# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8131 use iso_fortran_env, only: output_unit
8132# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8133
8134# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8135 print *, 'm_icpp_patches.fpp:579: ', '@:DEALLOCATE(x_coords)'
8136# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8137
8138# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8139 call flush (output_unit)
8140# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8141 end block
8142# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8143#endif
8144# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8145
8146# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8147#if defined(MFC_OpenACC)
8148# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8149!$acc exit data delete(x_coords)
8150# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8151#elif defined(MFC_OpenMP)
8152# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8153!$omp target exit data map(release:x_coords)
8154# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8155#endif
8156# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8157 deallocate (x_coords)
8158# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8159 end if
8160# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8161
8162# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8163 if (allocated(y_coords)) then
8164# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8165#ifdef MFC_DEBUG
8166# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8167 block
8168# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8169 use iso_fortran_env, only: output_unit
8170# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8171
8172# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8173 print *, 'm_icpp_patches.fpp:579: ', '@:DEALLOCATE(y_coords)'
8174# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8175
8176# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8177 call flush (output_unit)
8178# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8179 end block
8180# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8181#endif
8182# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8183
8184# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8185#if defined(MFC_OpenACC)
8186# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8187!$acc exit data delete(y_coords)
8188# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8189#elif defined(MFC_OpenMP)
8190# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8191!$omp target exit data map(release:y_coords)
8192# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8193#endif
8194# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8195 deallocate (y_coords)
8196# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8197 end if
8198
8199 end subroutine s_icpp_ellipsoid
8200
8201 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
8202 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
8203 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
8204 !! allow for the smoothing of its boundaries.
8205 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
8206
8207 integer, intent(in) :: patch_id
8208
8209#ifdef MFC_MIXED_PRECISION
8210 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8211#else
8212 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
8213#endif
8214 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8215 integer :: i, j, k !< generic loop iterators
8216 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
8217
8218 integer :: xRows, yRows, nRows, iix, iiy, max_files
8219# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8220 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8221# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8222 real(wp) :: x_len, x_step, y_len, y_step
8223# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8224 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8225# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8226 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
8227# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8228 real(wp) :: delta_x, delta_y
8229# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8230 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
8231# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8232 character(len=200) :: errmsg
8233# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8234 real(wp), allocatable :: stored_values(:,:,:)
8235# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8236 real(wp), allocatable :: x_coords(:), y_coords(:)
8237# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8238 logical :: files_loaded = .false.
8239# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8240 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8241# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8242 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
8243# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8244 character(len=20) :: file_num_str !< For storing the file number as a string
8245# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8246 character(len=20) :: zeros_part !< For the trailing zeros part
8247# 600 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8248 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
8249 ! Place any declaration of intermediate variables here
8250# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8251 real(wp) :: eps, eps_mhd, C_mhd
8252# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8253 real(wp) :: r, rmax, gam, umax, p0
8254# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8255 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
8256# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8257 real(wp) :: factor
8258# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8259 real(wp) :: r0, alpha, r2
8260# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8261 real(wp) :: sinA, cosA
8262# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8263 real(wp) :: r_sq
8264# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8265
8266# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8267 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
8268# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8269 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
8270# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8271 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
8272# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8273 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
8274# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8275 integer :: igq, jgq
8276# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8277
8278# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8279 ! # 291 - Shear/Thermal Layer Case
8280# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8281 real(wp) :: delta_shear, u_max, u_mean
8282# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8283 real(wp) :: T_wall, T_inf, P_atm, T_loc
8284# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8285 real(wp) :: delta_th, R_mix
8286# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8287 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
8288# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8289 real(wp) :: bottom_blend_u, bottom_blend_T
8290# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8291
8292# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8293 ! # 207
8294# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8295 real(wp) :: sigma, gauss1, gauss2
8296# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8297
8298# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8299 ! # 208
8300# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8301 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
8302# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8303
8304# 601 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8305 eps = 1.e-9_wp
8306
8307 pi_inf = pi_infs(1)
8308 gamma = gammas(1)
8309 lit_gamma = gs_min(1)
8310
8311 ! Transferring the rectangle's centroid and length information
8312 x_centroid = patch_icpp(patch_id)%x_centroid
8313 y_centroid = patch_icpp(patch_id)%y_centroid
8314 length_x = patch_icpp(patch_id)%length_x
8315 length_y = patch_icpp(patch_id)%length_y
8316
8317 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
8318 x_boundary%beg = x_centroid - 0.5_wp*length_x
8319 x_boundary%end = x_centroid + 0.5_wp*length_x
8320 y_boundary%beg = y_centroid - 0.5_wp*length_y
8321 y_boundary%end = y_centroid + 0.5_wp*length_y
8322
8323 ! Set eta=1 (no smoothing for this patch type)
8324 eta = 1._wp
8325
8326 ! Assign patch vars if cell is covered and patch has write permission
8327 do j = 0, n
8328 do i = 0, m
8329 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
8330 & .and. y_boundary%end >= y_cc(j)) then
8331 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
8332 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
8333
8334
8335
8336 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8337 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
8338# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8339 case (200) ! Two-fluid cubic interface
8340# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8341 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
8342# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8343 ! Volume Fractions
8344# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8345 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
8346# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8347 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
8348# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8349 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
8350# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8351 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
8352# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8353 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
8354# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8355 end if
8356# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8357 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
8358# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8359 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8360# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8361 rmax = 0.2_wp
8362# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8363
8364# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8365 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8366# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8367 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8368# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8369 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8370# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8371
8372# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8373 if (r < rmax) then
8374# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8375 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8376# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8377 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8378# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8379 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8380# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8381 else if (r < 2*rmax) then
8382# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8383 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8384# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8385 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8386# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8387 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)))
8388# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8389 else
8390# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8391 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8392# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8393 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8394# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8395 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
8396# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8397 end if
8398# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8399 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
8400# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8401 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8402# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8403 rmax = 0.2_wp
8404# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8405
8406# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8407 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8408# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8409 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8410# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8411 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8412# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8413
8414# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8415 if (r < rmax) then
8416# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8417 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8418# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8419 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8420# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8421 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8422# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8423 else if (r < 2*rmax) then
8424# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8425 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8426# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8427 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8428# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8429 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)))
8430# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8431 else
8432# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8433 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
8434# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8435 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
8436# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8437 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
8438# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8439 end if
8440# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8441
8442# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8443 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
8444# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8445 case (204) ! Rayleigh-Taylor instability
8446# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8447 rhoh = 3._wp
8448# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8449 rhol = 1._wp
8450# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8451 pref = 1.e5_wp
8452# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8453 pint = pref
8454# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8455 h = 0.7_wp
8456# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8457 lam = 0.2_wp
8458# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8459 wl = 2._wp*pi/lam
8460# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8461 amp = 0.05_wp/wl
8462# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8463
8464# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8465 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
8466# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8467
8468# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8469 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8470# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8471
8472# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8473 if (alph < eps) alph = eps
8474# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8475 if (alph > 1._wp - eps) alph = 1._wp - eps
8476# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8477
8478# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8479 if (y_cc(j) > inth) then
8480# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8481 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8482# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8483 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8484# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8485 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8486# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8487 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8488# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8489 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8490# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8491 else
8492# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8493 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
8494# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8495 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
8496# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8497 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
8498# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8499 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
8500# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8501 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8502# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8503 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
8504# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8505 end if
8506# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8507 case (205) ! 2D lung wave interaction problem
8508# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8509 h = 0.0_wp ! non dim origin y
8510# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8511 lam = 1.0_wp ! non dim lambda
8512# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8513 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
8514# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8515
8516# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8517 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
8518# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8519
8520# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8521 if (y_cc(j) > inth) then
8522# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8523 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8524# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8525 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8526# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8527 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8528# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8529 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8530# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8531 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8532# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8533 end if
8534# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8535 case (206) ! 2D lung wave interaction problem - horizontal domain
8536# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8537 h = 0.0_wp ! non dim origin y
8538# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8539 lam = 1.0_wp ! non dim lambda
8540# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8541 amp = patch_icpp(patch_id)%a(2)
8542# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8543
8544# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8545 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
8546# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8547
8548# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8549 if (x_cc(i) > intl) then ! this is the liquid
8550# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8551 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8552# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8553 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8554# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8555 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
8556# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8557 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8558# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8559 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8560# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8561 end if
8562# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8563 case (207) ! Kelvin Helmholtz Instability
8564# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8565 sigma = 0.05_wp/sqrt(2.0_wp)
8566# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8567 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
8568# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8569 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
8570# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8571 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)
8572# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8573 case (208) ! Richtmeyer Meshkov Instability
8574# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8575 lam = 1.0_wp
8576# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8577 eps = 1.0e-6_wp
8578# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8579 ei = 5.0_wp
8580# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8581 ! Smoothening function to smooth out sharp discontinuity in the interface
8582# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8583 if (x_cc(i) <= 0.7_wp*lam) then
8584# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8585 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
8586# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8587 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
8588# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8589 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
8590# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8591 alpha_sf6 = 1.0_wp - alpha_air
8592# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8593 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
8594# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8595 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
8596# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8597 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
8598# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8599 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
8600# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8601 end if
8602# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8603 case (250) ! MHD Orszag-Tang vortex
8604# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8605 ! 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),
8606# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8607 ! sin(4*pi*x)/sqrt(4*pi), 0)
8608# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8609
8610# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8611 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
8612# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8613 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
8614# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8615
8616# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8617 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
8618# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8619 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
8620# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8621 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
8622# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8623 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
8624# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8625 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
8626# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8627 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
8628# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8629 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
8630# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8631 ! Linear interpolation between r=0.08 and r=1.0
8632# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8633 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
8634# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8635 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
8636# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8637 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
8638# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8639 else
8640# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8641 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
8642# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8643 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
8644# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8645 end if
8646# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8647
8648# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8649 ! case 252 is for the 2D MHD Rotor problem
8650# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8651 case (252) ! 2D MHD Rotor Problem
8652# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8653 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
8654# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8655 !
8656# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8657 ! 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
8658# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8659 ! velocity w=20, giving v_tan=2 at r=0.1
8660# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8661
8662# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8663 ! Calculate distance squared from the center
8664# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8665 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
8666# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8667
8668# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8669 ! inner radius of 0.1
8670# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8671 if (r_sq <= 0.1**2) then
8672# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8673 ! -- Inside the rotor -- Set density uniformly to 10
8674# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8675 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
8676# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8677
8678# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8679 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
8680# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8681 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
8682# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8683 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
8684# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8685
8686# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8687 ! taper width of 0.015
8688# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8689 else if (r_sq <= 0.115**2) then
8690# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8691 ! linearly smooth the function between r = 0.1 and 0.115
8692# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8693 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8694# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8695
8696# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8697 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)
8698# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8699 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)
8700# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8701 end if
8702# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8703 case (253) ! MHD Smooth Magnetic Vortex
8704# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8705 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
8706# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8707 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8708# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8709
8710# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8711 ! velocity
8712# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8713 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))
8714# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8715 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))
8716# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8717
8718# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8719 ! magnetic field
8720# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8721 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)
8722# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8723 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)
8724# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8725
8726# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8727 ! pressure
8728# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8729 q_prim_vf(eqn_idx%E)%sf(i, j, &
8730# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8731 & 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)
8732# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8733 case (260) ! Gaussian Divergence Pulse
8734# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8735 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
8736# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8737 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
8738# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8739 ! initialized to zero everywhere.
8740# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8741
8742# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8743 eps_mhd = patch_icpp(patch_id)%a(2)
8744# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8745 sigma = patch_icpp(patch_id)%a(3)
8746# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8747 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8748# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8749
8750# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8751 ! B-field
8752# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8753 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8754# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8755 case (261) ! Blob
8756# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8757 r0 = 1._wp/sqrt(8._wp)
8758# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8759 r2 = x_cc(i)**2 + y_cc(j)**2
8760# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8761 r = sqrt(r2)
8762# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8763 alpha = r/r0
8764# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8765 if (alpha < 1) then
8766# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8767 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)
8768# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8769 ! 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)
8770# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8771 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
8772# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8773 ! 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
8774# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8775 end if
8776# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8777 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
8778# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8779 ! rotate by \alpha = atan(2)
8780# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8781 alpha = atan(2._wp)
8782# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8783 cosa = cos(alpha)
8784# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8785 sina = sin(alpha)
8786# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8787 ! projection along shock normal
8788# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8789 r = x_cc(i)*cosa + y_cc(j)*sina
8790# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8791
8792# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8793 if (r <= 0.5_wp) then
8794# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8795 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
8796# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8797 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8798# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8799 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
8800# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8801 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
8802# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8803 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
8804# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8805 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
8806# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8807 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
8808# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8809 else
8810# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8811 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
8812# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8813 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
8814# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8815 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
8816# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8817 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
8818# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8819 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
8820# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8821 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
8822# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8823 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
8824# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8825 end if
8826# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8827 ! v^z and B^z remain zero by default
8828# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8829 case (270) ! 2D extrusion of 1D profile from external data
8830# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8831 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8832# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8833 if (.not. files_loaded) then
8834# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8835 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8836# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8837 do f = 1, max_files
8838# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8839 write (file_num_str, '(I0)') f
8840# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8841 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
8842# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8843 end do
8844# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8845
8846# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8847 ! Common file reading setup
8848# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8849 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8850# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8851 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8852# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8853
8854# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8855 select case (num_dims)
8856# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8857 case (1, 2) ! 1D and 2D cases are similar
8858# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8859 ! Count lines
8860# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8861 line_count = 0
8862# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8863 do
8864# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8865 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8866# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8867 if (ios2 /= 0) exit
8868# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8869 line_count = line_count + 1
8870# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8871 end do
8872# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8873 close (unit2)
8874# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8875
8876# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8877 xrows = line_count
8878# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8879 yrows = 1
8880# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8881 index_x = 0
8882# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8883 if (num_dims == 2) index_x = i
8884# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8885#ifdef MFC_DEBUG
8886# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8887 block
8888# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8889 use iso_fortran_env, only: output_unit
8890# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8891
8892# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8893 print *, 'm_icpp_patches.fpp:633: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8894# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8895
8896# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8897 call flush (output_unit)
8898# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8899 end block
8900# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8901#endif
8902# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8903 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8904# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8905
8906# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8907
8908# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8909
8910# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8911#if defined(MFC_OpenACC)
8912# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8913!$acc enter data create(x_coords, stored_values)
8914# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8915#elif defined(MFC_OpenMP)
8916# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8917!$omp target enter data map(always,alloc:x_coords, stored_values)
8918# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8919#endif
8920# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8921
8922# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8923 ! Read data from all files
8924# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8925 do f = 1, max_files
8926# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8927 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8928# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8929 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8930# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8931
8932# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8933 do iter = 1, xrows
8934# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8935 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8936# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8937 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8938# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8939 end do
8940# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8941 close (unit)
8942# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8943 end do
8944# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8945
8946# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8947 ! Calculate offsets
8948# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8949 domain_xstart = x_coords(1)
8950# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8951 x_step = x_cc(1) - x_cc(0)
8952# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8953 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)
8954# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8955 global_offset_x = nint(abs(delta_x)/x_step)
8956# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8957 case (3) ! 3D case - determine grid structure
8958# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8959 ! Find yRows by counting rows with same x
8960# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8961 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8962# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8963 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8964# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8965
8966# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8967 yrows = 1
8968# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8969 do
8970# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8971 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8972# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8973 if (ios2 /= 0) exit
8974# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8975 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8976# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8977 yrows = yrows + 1
8978# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8979 else
8980# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8981 exit
8982# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8983 end if
8984# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8985 end do
8986# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8987 close (unit2)
8988# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8989
8990# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8991 ! Count total rows
8992# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8993 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8994# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8995 nrows = 0
8996# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8997 do
8998# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8999 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9000# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9001 if (ios2 /= 0) exit
9002# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9003 nrows = nrows + 1
9004# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9005 end do
9006# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9007 close (unit2)
9008# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9009
9010# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9011 xrows = nrows/yrows
9012# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9013#ifdef MFC_DEBUG
9014# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9015 block
9016# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9017 use iso_fortran_env, only: output_unit
9018# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9019
9020# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9021 print *, 'm_icpp_patches.fpp:633: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9022# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9023
9024# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9025 call flush (output_unit)
9026# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9027 end block
9028# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9029#endif
9030# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9031 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9032# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9033
9034# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9035
9036# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9037
9038# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9039
9040# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9041#if defined(MFC_OpenACC)
9042# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9043!$acc enter data create(x_coords, y_coords, stored_values)
9044# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9045#elif defined(MFC_OpenMP)
9046# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9047!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9048# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9049#endif
9050# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9051 index_x = i
9052# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9053 index_y = j
9054# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9055
9056# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9057 ! Read all files
9058# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9059 do f = 1, max_files
9060# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9061 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9062# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9063 if (ios /= 0) then
9064# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9065 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9066# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9067 cycle
9068# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9069 end if
9070# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9071
9072# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9073 iter = 0
9074# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9075 do iix = 1, xrows
9076# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9077 do iiy = 1, yrows
9078# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9079 iter = iter + 1
9080# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9081 if (f == 1) then
9082# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9083 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9084# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9085 else
9086# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9087 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9088# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9089 end if
9090# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9091 if (ios /= 0) call s_mpi_abort("Error reading data")
9092# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9093 end do
9094# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9095 end do
9096# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9097 close (unit)
9098# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9099 end do
9100# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9101
9102# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9103 ! Calculate offsets
9104# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9105 x_step = x_cc(1) - x_cc(0)
9106# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9107 y_step = y_cc(1) - y_cc(0)
9108# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9109 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9110# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9111 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9112# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9113 global_offset_x = nint(abs(delta_x)/x_step)
9114# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9115 global_offset_y = nint(abs(delta_y)/y_step)
9116# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9117 end select
9118# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9119
9120# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9121 files_loaded = .true.
9122# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9123 end if
9124# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9125
9126# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9127 ! Data assignment
9128# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9129 select case (num_dims)
9130# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9131 case (1)
9132# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9133 idx = i + 1 + global_offset_x
9134# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9135 do f = 1, sys_size
9136# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9137 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9138# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9139 end do
9140# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9141 case (2)
9142# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9143 idx = i + 1 + global_offset_x - index_x
9144# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9145 do f = 1, sys_size - 1
9146# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9147 jump = merge(1, 0, f >= eqn_idx%mom%end)
9148# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9149 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9150# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9151 end do
9152# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9153 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9154# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9155 case (3)
9156# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9157 idx = i + 1 + global_offset_x - index_x
9158# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9159 idy = j + 1 + global_offset_y - index_y
9160# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9161 do f = 1, sys_size - 1
9162# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9163 jump = merge(1, 0, f >= eqn_idx%mom%end)
9164# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9165 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9166# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9167 end do
9168# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9169 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9170# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9171 end select
9172# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9173 case (280) ! Isentropic vortex
9174# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9175 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
9176# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9177 ! geometry 2
9178# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9179 if (patch_id == 1) then
9180# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9181 q_prim_vf(eqn_idx%E)%sf(i, j, &
9182# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9183 & 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) &
9184# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9185 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9186# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9187 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9188# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9189 & 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) &
9190# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9191 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9192# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9193 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9194# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9195 & 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) &
9196# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9197 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9198# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9199 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9200# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9201 & 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) &
9202# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9203 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9204# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9205 end if
9206# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9207 case (281) ! Acoustic pulse
9208# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9209 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
9210# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9211 ! geometry 2
9212# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9213 if (patch_id == 2) then
9214# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9215 q_prim_vf(eqn_idx%E)%sf(i, j, &
9216# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9217 & 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))
9218# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9219 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9220# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9221 & 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))
9222# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9223 end if
9224# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9225 case (282) ! Zero-circulation vortex
9226# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9227 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
9228# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9229 ! geometry 2
9230# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9231 if (patch_id == 2) then
9232# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9233 q_prim_vf(eqn_idx%E)%sf(i, j, &
9234# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9235 & 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))
9236# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9237 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9238# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9239 & 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))
9240# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9241 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9242# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9243 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9244# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9245 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9246# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9247 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9248# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9249 end if
9250# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9251 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
9252# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9253 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
9254# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9255 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
9256# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9257 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
9258# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9259 ! patch_icpp(patch_id)%epsilon; defaults to 5.
9260# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9261 if (patch_id == 1) then
9262# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9263 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
9264# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9265 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
9266# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9267 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
9268# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9269 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
9270# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9271 do igq = 1, 3
9272# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9273 do jgq = 1, 3
9274# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9275 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
9276# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9277 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
9278# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9279 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
9280# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9281 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))
9282# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9283 wq = gauss_w(igq)*gauss_w(jgq)
9284# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9285 rhoq = t_facq**1.4_wp
9286# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9287 pq = t_facq**2.4_wp
9288# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9289 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9290# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9291 & - r2q)
9292# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9293 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9294# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9295 & - r2q)
9296# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9297 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
9298# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9299 rho_avg = rho_avg + wq*rhoq
9300# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9301 rhou_avg = rhou_avg + wq*(rhoq*uq)
9302# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9303 rhov_avg = rhov_avg + wq*(rhoq*vq)
9304# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9305 e_avg = e_avg + wq*eq
9306# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9307 end do
9308# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9309 end do
9310# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9311 rho_avg = rho_avg*0.25_wp
9312# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9313 rhou_avg = rhou_avg*0.25_wp
9314# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9315 rhov_avg = rhov_avg*0.25_wp
9316# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9317 e_avg = e_avg*0.25_wp
9318# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9319 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
9320# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9321 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
9322# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9323 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
9324# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9325 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
9326# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9327 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
9328# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9329 end if
9330# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9331 case (291) ! Isothermal Flat Plate
9332# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9333 t_inf = 1125.0_wp
9334# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9335 t_wall = 600.0_wp
9336# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9337 p_atm = 101325.0_wp
9338# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9339
9340# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9341 ! Boundary/Shear Layer thicknesses
9342# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9343 delta_th = 0.0003_wp ! Thermal BL thickness
9344# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9345 delta_shear = 8e-3_wp ! Velocity BL thickness
9346# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9347
9348# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9349 u_max = 50.0_wp ! Freestream Velocity (m/s)
9350# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9351
9352# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9353 mw_n2 = 28.0134e-3_wp
9354# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9355 mw_o2 = 31.999e-3_wp
9356# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9357 y_n2 = 0.767_wp
9358# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9359 y_o2 = 0.233_wp
9360# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9361 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
9362# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9363 bottom_blend_u = tanh(y_cc(j)/delta_shear)
9364# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9365 bottom_blend_t = tanh(y_cc(j)/delta_th)
9366# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9367 u_mean = u_max*bottom_blend_u
9368# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9369 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
9370# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9371 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
9372# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9373 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
9374# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9375 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9376# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9377 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
9378# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9379 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
9380# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9381 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
9382# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9383 case default
9384# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9385 if (proc_rank == 0) then
9386# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9387 call s_int_to_str(patch_id, istr)
9388# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9389 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
9390# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9391 end if
9392# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9393 end select
9394 end if
9395
9396 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then
9397 ! zero density, reassign according to Tait EOS
9398 q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(eqn_idx%E)%sf(i, j, &
9399 & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp &
9400 & - q_prim_vf(eqn_idx%alf)%sf(i, j, 0))
9401 end if
9402
9403 ! Updating the patch identities bookkeeping variable
9404 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9405 end if
9406 end if
9407 end do
9408 end do
9409 if (allocated(stored_values)) then
9410# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9411#ifdef MFC_DEBUG
9412# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9413 block
9414# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9415 use iso_fortran_env, only: output_unit
9416# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9417
9418# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9419 print *, 'm_icpp_patches.fpp:649: ', '@:DEALLOCATE(stored_values)'
9420# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9421
9422# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9423 call flush (output_unit)
9424# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9425 end block
9426# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9427#endif
9428# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9429
9430# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9431#if defined(MFC_OpenACC)
9432# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9433!$acc exit data delete(stored_values)
9434# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9435#elif defined(MFC_OpenMP)
9436# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9437!$omp target exit data map(release:stored_values)
9438# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9439#endif
9440# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9441 deallocate (stored_values)
9442# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9443#ifdef MFC_DEBUG
9444# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9445 block
9446# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9447 use iso_fortran_env, only: output_unit
9448# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9449
9450# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9451 print *, 'm_icpp_patches.fpp:649: ', '@:DEALLOCATE(x_coords)'
9452# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9453
9454# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9455 call flush (output_unit)
9456# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9457 end block
9458# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9459#endif
9460# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9461
9462# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9463#if defined(MFC_OpenACC)
9464# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9465!$acc exit data delete(x_coords)
9466# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9467#elif defined(MFC_OpenMP)
9468# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9469!$omp target exit data map(release:x_coords)
9470# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9471#endif
9472# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9473 deallocate (x_coords)
9474# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9475 end if
9476# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9477
9478# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9479 if (allocated(y_coords)) then
9480# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9481#ifdef MFC_DEBUG
9482# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9483 block
9484# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9485 use iso_fortran_env, only: output_unit
9486# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9487
9488# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9489 print *, 'm_icpp_patches.fpp:649: ', '@:DEALLOCATE(y_coords)'
9490# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9491
9492# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9493 call flush (output_unit)
9494# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9495 end block
9496# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9497#endif
9498# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9499
9500# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9501#if defined(MFC_OpenACC)
9502# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9503!$acc exit data delete(y_coords)
9504# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9505#elif defined(MFC_OpenMP)
9506# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9507!$omp target exit data map(release:y_coords)
9508# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9509#endif
9510# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9511 deallocate (y_coords)
9512# 649 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9513 end if
9514
9515 end subroutine s_icpp_rectangle
9516
9517 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
9518 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
9519 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
9520 !! the smoothing of its boundary.
9521 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
9522
9523 integer, intent(in) :: patch_id
9524
9525#ifdef MFC_MIXED_PRECISION
9526 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9527#else
9528 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9529#endif
9530 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9531 integer :: i, j, k !< Generic loop operators
9532 real(wp) :: a, b, c
9533
9534 integer :: xRows, yRows, nRows, iix, iiy, max_files
9535# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9536 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9537# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9538 real(wp) :: x_len, x_step, y_len, y_step
9539# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9540 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9541# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9542 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
9543# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9544 real(wp) :: delta_x, delta_y
9545# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9546 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
9547# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9548 character(len=200) :: errmsg
9549# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9550 real(wp), allocatable :: stored_values(:,:,:)
9551# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9552 real(wp), allocatable :: x_coords(:), y_coords(:)
9553# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9554 logical :: files_loaded = .false.
9555# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9556 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9557# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9558 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
9559# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9560 character(len=20) :: file_num_str !< For storing the file number as a string
9561# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9562 character(len=20) :: zeros_part !< For the trailing zeros part
9563# 670 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9564 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
9565 ! Place any declaration of intermediate variables here
9566# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9567 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9568# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9569 real(wp) :: eps
9570# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9571
9572# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9573 ! IGR Jets Arrays to stor position and radii of jets from input file
9574# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9575 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9576# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9577 ! Variables to describe initial condition of jet
9578# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9579 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9580# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9581 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
9582# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9583 real(wp), dimension(0:n,0:p) :: rcut_arr
9584# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9585 integer :: l, q, s !< Iterators for reading input files
9586# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9587 integer :: start, end !< Ints to keep track of position in file
9588# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9589 character(len=1000) :: line !< String to store line in file
9590# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9591 character(len=25) :: value !< String to store value in line
9592# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9593 integer :: NJet !< Number of jets
9594# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9595
9596# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9597 eps = 1e-9_wp
9598# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9599
9600# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9601 if (patch_icpp(patch_id)%hcid == 303) then
9602# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9603 eps_smooth = 3._wp
9604# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9605 open (unit=10, file="njet.txt", status="old", action="read")
9606# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9607 read (10, *) njet
9608# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9609 close (10)
9610# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9611
9612# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9613 allocate (y_th_arr(0:njet - 1))
9614# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9615 allocate (z_th_arr(0:njet - 1))
9616# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9617 allocate (r_th_arr(0:njet - 1))
9618# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9619
9620# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9621 open (unit=10, file="jets.csv", status="old", action="read")
9622# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9623 do q = 0, njet - 1
9624# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9625 read (10, '(A)') line ! Read a full line as a string
9626# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9627 start = 1
9628# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9629
9630# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9631 do l = 0, 2
9632# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9633 end = index(line(start:), ',') ! Find the next comma
9634# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9635 if (end == 0) then
9636# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9637 value = trim(adjustl(line(start:))) ! Last value in the line
9638# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9639 else
9640# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9641 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
9642# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9643 start = start + end ! Move to next value
9644# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9645 end if
9646# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9647 if (l == 0) then
9648# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9649 read (value, *) y_th_arr(q) ! Convert string to numeric value
9650# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9651 else if (l == 1) then
9652# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9653 read (value, *) z_th_arr(q)
9654# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9655 else
9656# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9657 read (value, *) r_th_arr(q)
9658# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9659 end if
9660# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9661 end do
9662# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9663 end do
9664# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9665 close (10)
9666# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9667
9668# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9669 do q = 0, p
9670# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9671 do l = 0, n
9672# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9673 rcut = 0._wp
9674# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9675 do s = 0, njet - 1
9676# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9677 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
9678# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9679 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
9680# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9681 end do
9682# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9683 rcut_arr(l, q) = rcut
9684# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9685 end do
9686# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9687 end do
9688# 671 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9689 end if
9690
9691 ! Transferring the centroid information of the line to be swept
9692 x_centroid = patch_icpp(patch_id)%x_centroid
9693 y_centroid = patch_icpp(patch_id)%y_centroid
9694 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
9695 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
9696
9697 ! Obtaining coefficients of the equation describing the sweep line
9698 a = patch_icpp(patch_id)%normal(1)
9699 b = patch_icpp(patch_id)%normal(2)
9700 c = -a*x_centroid - b*y_centroid
9701
9702 ! Initialize eta=1; modified if smoothing is enabled
9703 eta = 1._wp
9704
9705 ! Assign patch vars if cell is covered and patch has write permission
9706 do j = 0, n
9707 do i = 0, m
9708 if (patch_icpp(patch_id)%smoothen) then
9709 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))
9710 end if
9711
9712 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
9713 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
9714 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
9715
9716
9717 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9718 select case (patch_icpp(patch_id)%hcid)
9719# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9720 case (300) ! Rayleigh-Taylor instability
9721# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9722 rhoh = 3._wp
9723# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9724 rhol = 1._wp
9725# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9726 pref = 1.e5_wp
9727# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9728 pint = pref
9729# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9730 h = 0.7_wp
9731# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9732 lam = 0.2_wp
9733# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9734 wl = 2._wp*pi/lam
9735# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9736 amp = 0.025_wp/wl
9737# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9738
9739# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9740 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
9741# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9742
9743# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9744 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9745# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9746
9747# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9748 if (alph < eps) alph = eps
9749# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9750 if (alph > 1._wp - eps) alph = 1._wp - eps
9751# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9752
9753# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9754 if (y_cc(j) > inth) then
9755# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9756 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9757# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9758 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9759# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9760 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9761# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9762 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9763# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9764 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9765# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9766 else
9767# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9768 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
9769# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9770 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
9771# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9772 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
9773# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9774 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
9775# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9776 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9777# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9778 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
9779# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9780 end if
9781# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9782 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
9783# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9784 h = 0.0_wp
9785# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9786 lam = 1.0_wp
9787# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9788 amp = patch_icpp(patch_id)%a(2)
9789# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9790 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
9791# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9792 if (x_cc(i) > inth) then
9793# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9794 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
9795# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9796 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
9797# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9798 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
9799# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9800 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
9801# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9802 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
9803# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9804 end if
9805# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9806 case (302) ! 3D Jet with IGR
9807# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9808 ux_th = 10*sqrt(1.4*0.4)
9809# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9810 ux_am = 0.0*sqrt(1.4)
9811# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9812 p_th = 2.0_wp
9813# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9814 p_am = 1.0_wp
9815# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9816 rho_th = 1._wp
9817# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9818 rho_am = 1._wp
9819# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9820 y_th = 0.0_wp
9821# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9822 z_th = 0.0_wp
9823# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9824 r_th = 1._wp
9825# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9826 eps_smooth = 1._wp
9827# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9828 eps = 1e-6
9829# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9830
9831# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9832 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
9833# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9834 rcut = f_cut_on(r - r_th, eps_smooth)
9835# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9836 xcut = f_cut_on(x_cc(i), eps_smooth)
9837# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9838
9839# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9840 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9841# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9842 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9843# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9844 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9845# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9846
9847# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9848 if (num_fluids == 1) then
9849# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9850 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9851# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9852 else
9853# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9854 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9855# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9856 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9857# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9858 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))
9859# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9860 end if
9861# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9862
9863# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9864 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9865# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9866 case (303) ! 3D Multijet
9867# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9868 eps_smooth = 3.0_wp
9869# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9870 ux_th = 10*sqrt(1.4*0.4)
9871# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9872 ux_am = 2.5*sqrt(1.4*0.4)
9873# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9874 p_th = 0.8_wp
9875# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9876 p_am = 0.4_wp
9877# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9878 rho_th = 1._wp
9879# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9880 rho_am = 1._wp
9881# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9882 eps = 1e-6
9883# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9884
9885# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9886 rcut = rcut_arr(j, k)
9887# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9888 xcut = f_cut_on(x_cc(i), eps_smooth)
9889# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9890
9891# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9892 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9893# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9894 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
9895# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9896 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
9897# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9898
9899# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9900 if (num_fluids == 1) then
9901# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9902 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9903# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9904 else
9905# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9906 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9907# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9908 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
9909# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9910 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))
9911# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9912 end if
9913# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9914
9915# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9916 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
9917# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9918 case (370) ! 3D extrusion of 2D profile from external data
9919# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9920 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9921# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9922 if (.not. files_loaded) then
9923# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9924 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9925# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9926 do f = 1, max_files
9927# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9928 write (file_num_str, '(I0)') f
9929# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9930 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
9931# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9932 end do
9933# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9934
9935# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9936 ! Common file reading setup
9937# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9938 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9939# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9940 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9941# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9942
9943# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9944 select case (num_dims)
9945# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9946 case (1, 2) ! 1D and 2D cases are similar
9947# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9948 ! Count lines
9949# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9950 line_count = 0
9951# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9952 do
9953# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9954 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9955# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9956 if (ios2 /= 0) exit
9957# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9958 line_count = line_count + 1
9959# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9960 end do
9961# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9962 close (unit2)
9963# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9964
9965# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9966 xrows = line_count
9967# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9968 yrows = 1
9969# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9970 index_x = 0
9971# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9972 if (num_dims == 2) index_x = i
9973# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9974#ifdef MFC_DEBUG
9975# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9976 block
9977# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9978 use iso_fortran_env, only: output_unit
9979# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9980
9981# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9982 print *, 'm_icpp_patches.fpp:700: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9983# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9984
9985# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9986 call flush (output_unit)
9987# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9988 end block
9989# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9990#endif
9991# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9992 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9993# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9994
9995# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9996
9997# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9998
9999# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10000#if defined(MFC_OpenACC)
10001# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10002!$acc enter data create(x_coords, stored_values)
10003# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10004#elif defined(MFC_OpenMP)
10005# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10006!$omp target enter data map(always,alloc:x_coords, stored_values)
10007# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10008#endif
10009# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10010
10011# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10012 ! Read data from all files
10013# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10014 do f = 1, max_files
10015# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10016 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10017# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10018 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10019# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10020
10021# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10022 do iter = 1, xrows
10023# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10024 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10025# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10026 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10027# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10028 end do
10029# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10030 close (unit)
10031# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10032 end do
10033# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10034
10035# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10036 ! Calculate offsets
10037# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10038 domain_xstart = x_coords(1)
10039# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10040 x_step = x_cc(1) - x_cc(0)
10041# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10042 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)
10043# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10044 global_offset_x = nint(abs(delta_x)/x_step)
10045# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10046 case (3) ! 3D case - determine grid structure
10047# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10048 ! Find yRows by counting rows with same x
10049# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10050 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10051# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10052 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10053# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10054
10055# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10056 yrows = 1
10057# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10058 do
10059# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10060 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10061# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10062 if (ios2 /= 0) exit
10063# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10064 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
10065# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10066 yrows = yrows + 1
10067# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10068 else
10069# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10070 exit
10071# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10072 end if
10073# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10074 end do
10075# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10076 close (unit2)
10077# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10078
10079# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10080 ! Count total rows
10081# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10082 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10083# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10084 nrows = 0
10085# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10086 do
10087# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10088 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10089# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10090 if (ios2 /= 0) exit
10091# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10092 nrows = nrows + 1
10093# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10094 end do
10095# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10096 close (unit2)
10097# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10098
10099# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10100 xrows = nrows/yrows
10101# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10102#ifdef MFC_DEBUG
10103# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10104 block
10105# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10106 use iso_fortran_env, only: output_unit
10107# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10108
10109# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10110 print *, 'm_icpp_patches.fpp:700: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
10111# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10112
10113# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10114 call flush (output_unit)
10115# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10116 end block
10117# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10118#endif
10119# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10120 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
10121# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10122
10123# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10124
10125# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10126
10127# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10128
10129# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10130#if defined(MFC_OpenACC)
10131# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10132!$acc enter data create(x_coords, y_coords, stored_values)
10133# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10134#elif defined(MFC_OpenMP)
10135# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10136!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
10137# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10138#endif
10139# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10140 index_x = i
10141# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10142 index_y = j
10143# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10144
10145# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10146 ! Read all files
10147# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10148 do f = 1, max_files
10149# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10150 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10151# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10152 if (ios /= 0) then
10153# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10154 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10155# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10156 cycle
10157# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10158 end if
10159# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10160
10161# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10162 iter = 0
10163# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10164 do iix = 1, xrows
10165# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10166 do iiy = 1, yrows
10167# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10168 iter = iter + 1
10169# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10170 if (f == 1) then
10171# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10172 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
10173# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10174 else
10175# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10176 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
10177# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10178 end if
10179# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10180 if (ios /= 0) call s_mpi_abort("Error reading data")
10181# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10182 end do
10183# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10184 end do
10185# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10186 close (unit)
10187# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10188 end do
10189# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10190
10191# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10192 ! Calculate offsets
10193# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10194 x_step = x_cc(1) - x_cc(0)
10195# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10196 y_step = y_cc(1) - y_cc(0)
10197# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10198 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
10199# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10200 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
10201# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10202 global_offset_x = nint(abs(delta_x)/x_step)
10203# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10204 global_offset_y = nint(abs(delta_y)/y_step)
10205# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10206 end select
10207# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10208
10209# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10210 files_loaded = .true.
10211# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10212 end if
10213# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10214
10215# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10216 ! Data assignment
10217# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10218 select case (num_dims)
10219# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10220 case (1)
10221# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10222 idx = i + 1 + global_offset_x
10223# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10224 do f = 1, sys_size
10225# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10226 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10227# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10228 end do
10229# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10230 case (2)
10231# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10232 idx = i + 1 + global_offset_x - index_x
10233# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10234 do f = 1, sys_size - 1
10235# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10236 jump = merge(1, 0, f >= eqn_idx%mom%end)
10237# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10238 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10239# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10240 end do
10241# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10242 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
10243# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10244 case (3)
10245# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10246 idx = i + 1 + global_offset_x - index_x
10247# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10248 idy = j + 1 + global_offset_y - index_y
10249# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10250 do f = 1, sys_size - 1
10251# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10252 jump = merge(1, 0, f >= eqn_idx%mom%end)
10253# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10254 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10255# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10256 end do
10257# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10258 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
10259# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10260 end select
10261# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10262 case (380) ! Taylor-Green vortex
10263# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10264 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
10265# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10266 ! geometry 9
10267# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10268 mach = 0.1
10269# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10270 if (patch_id == 1) then
10271# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10272 q_prim_vf(eqn_idx%E)%sf(i, j, &
10273# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10274 & 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)
10275# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10276 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)
10277# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10278 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)
10279# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10280 end if
10281# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10282 case default
10283# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10284 call s_int_to_str(patch_id, istr)
10285# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10286 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10287# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10288 end select
10289 end if
10290
10291 ! Updating the patch identities bookkeeping variable
10292 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10293 end if
10294 end do
10295 end do
10296 if (allocated(stored_values)) then
10297# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10298#ifdef MFC_DEBUG
10299# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10300 block
10301# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10302 use iso_fortran_env, only: output_unit
10303# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10304
10305# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10306 print *, 'm_icpp_patches.fpp:708: ', '@:DEALLOCATE(stored_values)'
10307# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10308
10309# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10310 call flush (output_unit)
10311# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10312 end block
10313# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10314#endif
10315# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10316
10317# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10318#if defined(MFC_OpenACC)
10319# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10320!$acc exit data delete(stored_values)
10321# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10322#elif defined(MFC_OpenMP)
10323# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10324!$omp target exit data map(release:stored_values)
10325# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10326#endif
10327# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10328 deallocate (stored_values)
10329# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10330#ifdef MFC_DEBUG
10331# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10332 block
10333# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10334 use iso_fortran_env, only: output_unit
10335# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10336
10337# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10338 print *, 'm_icpp_patches.fpp:708: ', '@:DEALLOCATE(x_coords)'
10339# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10340
10341# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10342 call flush (output_unit)
10343# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10344 end block
10345# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10346#endif
10347# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10348
10349# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10350#if defined(MFC_OpenACC)
10351# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10352!$acc exit data delete(x_coords)
10353# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10354#elif defined(MFC_OpenMP)
10355# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10356!$omp target exit data map(release:x_coords)
10357# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10358#endif
10359# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10360 deallocate (x_coords)
10361# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10362 end if
10363# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10364
10365# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10366 if (allocated(y_coords)) then
10367# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10368#ifdef MFC_DEBUG
10369# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10370 block
10371# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10372 use iso_fortran_env, only: output_unit
10373# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10374
10375# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10376 print *, 'm_icpp_patches.fpp:708: ', '@:DEALLOCATE(y_coords)'
10377# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10378
10379# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10380 call flush (output_unit)
10381# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10382 end block
10383# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10384#endif
10385# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10386
10387# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10388#if defined(MFC_OpenACC)
10389# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10390!$acc exit data delete(y_coords)
10391# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10392#elif defined(MFC_OpenMP)
10393# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10394!$omp target exit data map(release:y_coords)
10395# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10396#endif
10397# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10398 deallocate (y_coords)
10399# 708 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10400 end if
10401
10402 end subroutine s_icpp_sweep_line
10403
10404 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
10405 !! Geometry of the patch is well-defined when its centroid are provided.
10406 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
10407
10408 integer, intent(in) :: patch_id
10409
10410#ifdef MFC_MIXED_PRECISION
10411 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10412#else
10413 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10414#endif
10415 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10416 integer :: i, j, k !< generic loop iterators
10417 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
10418 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
10419
10420 integer :: xRows, yRows, nRows, iix, iiy, max_files
10421# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10422 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10423# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10424 real(wp) :: x_len, x_step, y_len, y_step
10425# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10426 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10427# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10428 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
10429# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10430 real(wp) :: delta_x, delta_y
10431# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10432 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
10433# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10434 character(len=200) :: errmsg
10435# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10436 real(wp), allocatable :: stored_values(:,:,:)
10437# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10438 real(wp), allocatable :: x_coords(:), y_coords(:)
10439# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10440 logical :: files_loaded = .false.
10441# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10442 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10443# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10444 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
10445# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10446 character(len=20) :: file_num_str !< For storing the file number as a string
10447# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10448 character(len=20) :: zeros_part !< For the trailing zeros part
10449# 728 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10450 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
10451 ! Place any declaration of intermediate variables here
10452# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10453 real(wp) :: eps, eps_mhd, C_mhd
10454# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10455 real(wp) :: r, rmax, gam, umax, p0
10456# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10457 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
10458# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10459 real(wp) :: factor
10460# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10461 real(wp) :: r0, alpha, r2
10462# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10463 real(wp) :: sinA, cosA
10464# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10465 real(wp) :: r_sq
10466# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10467
10468# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10469 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
10470# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10471 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
10472# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10473 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
10474# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10475 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
10476# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10477 integer :: igq, jgq
10478# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10479
10480# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10481 ! # 291 - Shear/Thermal Layer Case
10482# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10483 real(wp) :: delta_shear, u_max, u_mean
10484# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10485 real(wp) :: T_wall, T_inf, P_atm, T_loc
10486# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10487 real(wp) :: delta_th, R_mix
10488# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10489 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
10490# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10491 real(wp) :: bottom_blend_u, bottom_blend_T
10492# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10493
10494# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10495 ! # 207
10496# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10497 real(wp) :: sigma, gauss1, gauss2
10498# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10499
10500# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10501 ! # 208
10502# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10503 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
10504# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10505
10506# 729 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10507 eps = 1.e-9_wp
10508
10509 pi_inf = pi_infs(1)
10510 gamma = gammas(1)
10511 lit_gamma = gs_min(1)
10512
10513 ! Transferring the patch's centroid and length information
10514 x_centroid = patch_icpp(patch_id)%x_centroid
10515 y_centroid = patch_icpp(patch_id)%y_centroid
10516 length_x = patch_icpp(patch_id)%length_x
10517 length_y = patch_icpp(patch_id)%length_y
10518
10519 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
10520 x_boundary%beg = x_centroid - 0.5_wp*length_x
10521 x_boundary%end = x_centroid + 0.5_wp*length_x
10522 y_boundary%beg = y_centroid - 0.5_wp*length_y
10523 y_boundary%end = y_centroid + 0.5_wp*length_y
10524
10525 ! Set eta=1 (no smoothing for this patch type)
10526 eta = 1._wp
10527 ! U0 is the characteristic velocity of the vortex
10528 u0 = patch_icpp(patch_id)%vel(1)
10529 ! L0 is the characteristic length of the vortex
10530 l0 = patch_icpp(patch_id)%vel(2)
10531 ! Assign patch vars if cell is covered and patch has write permission
10532 do j = 0, n
10533 do i = 0, m
10534 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) &
10535 & .and. y_boundary%end >= y_cc(j) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
10536 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
10537
10538
10539 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10540 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
10541# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10542 case (200) ! Two-fluid cubic interface
10543# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10544 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
10545# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10546 ! Volume Fractions
10547# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10548 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
10549# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10550 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
10551# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10552 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
10553# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10554 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
10555# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10556 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
10557# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10558 end if
10559# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10560 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
10561# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10562 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10563# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10564 rmax = 0.2_wp
10565# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10566
10567# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10568 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10569# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10570 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10571# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10572 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10573# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10574
10575# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10576 if (r < rmax) then
10577# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10578 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10579# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10580 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10581# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10582 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10583# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10584 else if (r < 2*rmax) then
10585# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10586 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10587# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10588 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10589# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10590 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)))
10591# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10592 else
10593# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10594 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10595# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10596 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10597# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10598 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
10599# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10600 end if
10601# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10602 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
10603# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10604 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10605# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10606 rmax = 0.2_wp
10607# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10608
10609# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10610 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10611# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10612 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10613# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10614 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10615# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10616
10617# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10618 if (r < rmax) then
10619# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10620 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10621# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10622 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10623# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10624 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10625# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10626 else if (r < 2*rmax) then
10627# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10628 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10629# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10630 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10631# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10632 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)))
10633# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10634 else
10635# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10636 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
10637# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10638 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
10639# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10640 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
10641# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10642 end if
10643# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10644
10645# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10646 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
10647# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10648 case (204) ! Rayleigh-Taylor instability
10649# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10650 rhoh = 3._wp
10651# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10652 rhol = 1._wp
10653# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10654 pref = 1.e5_wp
10655# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10656 pint = pref
10657# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10658 h = 0.7_wp
10659# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10660 lam = 0.2_wp
10661# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10662 wl = 2._wp*pi/lam
10663# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10664 amp = 0.05_wp/wl
10665# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10666
10667# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10668 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
10669# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10670
10671# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10672 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10673# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10674
10675# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10676 if (alph < eps) alph = eps
10677# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10678 if (alph > 1._wp - eps) alph = 1._wp - eps
10679# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10680
10681# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10682 if (y_cc(j) > inth) then
10683# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10684 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10685# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10686 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10687# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10688 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10689# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10690 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10691# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10692 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10693# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10694 else
10695# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10696 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
10697# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10698 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
10699# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10700 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
10701# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10702 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
10703# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10704 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10705# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10706 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
10707# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10708 end if
10709# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10710 case (205) ! 2D lung wave interaction problem
10711# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10712 h = 0.0_wp ! non dim origin y
10713# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10714 lam = 1.0_wp ! non dim lambda
10715# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10716 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
10717# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10718
10719# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10720 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
10721# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10722
10723# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10724 if (y_cc(j) > inth) then
10725# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10726 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10727# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10728 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10729# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10730 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10731# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10732 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10733# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10734 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10735# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10736 end if
10737# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10738 case (206) ! 2D lung wave interaction problem - horizontal domain
10739# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10740 h = 0.0_wp ! non dim origin y
10741# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10742 lam = 1.0_wp ! non dim lambda
10743# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10744 amp = patch_icpp(patch_id)%a(2)
10745# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10746
10747# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10748 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
10749# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10750
10751# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10752 if (x_cc(i) > intl) then ! this is the liquid
10753# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10754 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10755# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10756 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10757# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10758 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
10759# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10760 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10761# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10762 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10763# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10764 end if
10765# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10766 case (207) ! Kelvin Helmholtz Instability
10767# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10768 sigma = 0.05_wp/sqrt(2.0_wp)
10769# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10770 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
10771# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10772 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
10773# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10774 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)
10775# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10776 case (208) ! Richtmeyer Meshkov Instability
10777# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10778 lam = 1.0_wp
10779# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10780 eps = 1.0e-6_wp
10781# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10782 ei = 5.0_wp
10783# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10784 ! Smoothening function to smooth out sharp discontinuity in the interface
10785# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10786 if (x_cc(i) <= 0.7_wp*lam) then
10787# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10788 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
10789# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10790 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
10791# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10792 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
10793# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10794 alpha_sf6 = 1.0_wp - alpha_air
10795# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10796 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
10797# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10798 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
10799# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10800 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
10801# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10802 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
10803# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10804 end if
10805# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10806 case (250) ! MHD Orszag-Tang vortex
10807# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10808 ! 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),
10809# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10810 ! sin(4*pi*x)/sqrt(4*pi), 0)
10811# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10812
10813# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10814 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
10815# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10816 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
10817# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10818
10819# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10820 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
10821# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10822 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
10823# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10824 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
10825# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10826 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
10827# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10828 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
10829# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10830 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
10831# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10832 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
10833# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10834 ! Linear interpolation between r=0.08 and r=1.0
10835# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10836 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
10837# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10838 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
10839# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10840 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
10841# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10842 else
10843# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10844 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
10845# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10846 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
10847# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10848 end if
10849# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10850
10851# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10852 ! case 252 is for the 2D MHD Rotor problem
10853# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10854 case (252) ! 2D MHD Rotor Problem
10855# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10856 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
10857# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10858 !
10859# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10860 ! 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
10861# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10862 ! velocity w=20, giving v_tan=2 at r=0.1
10863# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10864
10865# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10866 ! Calculate distance squared from the center
10867# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10868 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10869# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10870
10871# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10872 ! inner radius of 0.1
10873# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10874 if (r_sq <= 0.1**2) then
10875# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10876 ! -- Inside the rotor -- Set density uniformly to 10
10877# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10878 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
10879# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10880
10881# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10882 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
10883# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10884 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10885# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10886 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10887# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10888
10889# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10890 ! taper width of 0.015
10891# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10892 else if (r_sq <= 0.115**2) then
10893# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10894 ! linearly smooth the function between r = 0.1 and 0.115
10895# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10896 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10897# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10898
10899# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10900 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)
10901# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10902 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)
10903# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10904 end if
10905# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10906 case (253) ! MHD Smooth Magnetic Vortex
10907# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10908 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
10909# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10910 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10911# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10912
10913# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10914 ! velocity
10915# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10916 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))
10917# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10918 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))
10919# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10920
10921# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10922 ! magnetic field
10923# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10924 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)
10925# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10926 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)
10927# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10928
10929# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10930 ! pressure
10931# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10932 q_prim_vf(eqn_idx%E)%sf(i, j, &
10933# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10934 & 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)
10935# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10936 case (260) ! Gaussian Divergence Pulse
10937# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10938 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
10939# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10940 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
10941# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10942 ! initialized to zero everywhere.
10943# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10944
10945# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10946 eps_mhd = patch_icpp(patch_id)%a(2)
10947# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10948 sigma = patch_icpp(patch_id)%a(3)
10949# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10950 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10951# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10952
10953# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10954 ! B-field
10955# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10956 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10957# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10958 case (261) ! Blob
10959# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10960 r0 = 1._wp/sqrt(8._wp)
10961# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10962 r2 = x_cc(i)**2 + y_cc(j)**2
10963# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10964 r = sqrt(r2)
10965# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10966 alpha = r/r0
10967# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10968 if (alpha < 1) then
10969# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10970 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)
10971# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10972 ! 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)
10973# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10974 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
10975# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10976 ! 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
10977# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10978 end if
10979# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10980 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
10981# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10982 ! rotate by \alpha = atan(2)
10983# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10984 alpha = atan(2._wp)
10985# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10986 cosa = cos(alpha)
10987# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10988 sina = sin(alpha)
10989# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10990 ! projection along shock normal
10991# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10992 r = x_cc(i)*cosa + y_cc(j)*sina
10993# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10994
10995# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10996 if (r <= 0.5_wp) then
10997# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10998 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
10999# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11000 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11001# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11002 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
11003# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11004 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
11005# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11006 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
11007# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11008 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
11009# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11010 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
11011# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11012 else
11013# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11014 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
11015# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11016 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11017# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11018 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
11019# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11020 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
11021# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11022 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
11023# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11024 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
11025# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11026 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
11027# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11028 end if
11029# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11030 ! v^z and B^z remain zero by default
11031# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11032 case (270) ! 2D extrusion of 1D profile from external data
11033# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11034 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
11035# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11036 if (.not. files_loaded) then
11037# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11038 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11039# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11040 do f = 1, max_files
11041# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11042 write (file_num_str, '(I0)') f
11043# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11044 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11045# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11046 end do
11047# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11048
11049# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11050 ! Common file reading setup
11051# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11052 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11053# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11054 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11055# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11056
11057# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11058 select case (num_dims)
11059# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11060 case (1, 2) ! 1D and 2D cases are similar
11061# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11062 ! Count lines
11063# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11064 line_count = 0
11065# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11066 do
11067# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11068 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11069# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11070 if (ios2 /= 0) exit
11071# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11072 line_count = line_count + 1
11073# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11074 end do
11075# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11076 close (unit2)
11077# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11078
11079# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11080 xrows = line_count
11081# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11082 yrows = 1
11083# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11084 index_x = 0
11085# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11086 if (num_dims == 2) index_x = i
11087# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11088#ifdef MFC_DEBUG
11089# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11090 block
11091# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11092 use iso_fortran_env, only: output_unit
11093# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11094
11095# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11096 print *, 'm_icpp_patches.fpp:762: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11097# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11098
11099# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11100 call flush (output_unit)
11101# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11102 end block
11103# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11104#endif
11105# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11106 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11107# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11108
11109# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11110
11111# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11112
11113# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11114#if defined(MFC_OpenACC)
11115# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11116!$acc enter data create(x_coords, stored_values)
11117# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11118#elif defined(MFC_OpenMP)
11119# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11120!$omp target enter data map(always,alloc:x_coords, stored_values)
11121# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11122#endif
11123# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11124
11125# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11126 ! Read data from all files
11127# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11128 do f = 1, max_files
11129# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11130 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11131# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11132 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11133# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11134
11135# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11136 do iter = 1, xrows
11137# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11138 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11139# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11140 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11141# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11142 end do
11143# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11144 close (unit)
11145# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11146 end do
11147# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11148
11149# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11150 ! Calculate offsets
11151# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11152 domain_xstart = x_coords(1)
11153# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11154 x_step = x_cc(1) - x_cc(0)
11155# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11156 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)
11157# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11158 global_offset_x = nint(abs(delta_x)/x_step)
11159# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11160 case (3) ! 3D case - determine grid structure
11161# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11162 ! Find yRows by counting rows with same x
11163# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11164 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11165# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11166 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11167# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11168
11169# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11170 yrows = 1
11171# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11172 do
11173# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11174 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11175# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11176 if (ios2 /= 0) exit
11177# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11178 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11179# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11180 yrows = yrows + 1
11181# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11182 else
11183# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11184 exit
11185# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11186 end if
11187# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11188 end do
11189# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11190 close (unit2)
11191# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11192
11193# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11194 ! Count total rows
11195# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11196 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11197# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11198 nrows = 0
11199# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11200 do
11201# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11202 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11203# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11204 if (ios2 /= 0) exit
11205# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11206 nrows = nrows + 1
11207# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11208 end do
11209# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11210 close (unit2)
11211# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11212
11213# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11214 xrows = nrows/yrows
11215# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11216#ifdef MFC_DEBUG
11217# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11218 block
11219# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11220 use iso_fortran_env, only: output_unit
11221# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11222
11223# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11224 print *, 'm_icpp_patches.fpp:762: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11225# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11226
11227# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11228 call flush (output_unit)
11229# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11230 end block
11231# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11232#endif
11233# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11234 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11235# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11236
11237# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11238
11239# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11240
11241# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11242
11243# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11244#if defined(MFC_OpenACC)
11245# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11246!$acc enter data create(x_coords, y_coords, stored_values)
11247# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11248#elif defined(MFC_OpenMP)
11249# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11250!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11251# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11252#endif
11253# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11254 index_x = i
11255# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11256 index_y = j
11257# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11258
11259# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11260 ! Read all files
11261# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11262 do f = 1, max_files
11263# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11264 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11265# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11266 if (ios /= 0) then
11267# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11268 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11269# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11270 cycle
11271# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11272 end if
11273# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11274
11275# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11276 iter = 0
11277# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11278 do iix = 1, xrows
11279# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11280 do iiy = 1, yrows
11281# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11282 iter = iter + 1
11283# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11284 if (f == 1) then
11285# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11286 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11287# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11288 else
11289# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11290 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11291# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11292 end if
11293# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11294 if (ios /= 0) call s_mpi_abort("Error reading data")
11295# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11296 end do
11297# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11298 end do
11299# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11300 close (unit)
11301# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11302 end do
11303# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11304
11305# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11306 ! Calculate offsets
11307# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11308 x_step = x_cc(1) - x_cc(0)
11309# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11310 y_step = y_cc(1) - y_cc(0)
11311# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11312 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11313# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11314 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11315# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11316 global_offset_x = nint(abs(delta_x)/x_step)
11317# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11318 global_offset_y = nint(abs(delta_y)/y_step)
11319# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11320 end select
11321# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11322
11323# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11324 files_loaded = .true.
11325# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11326 end if
11327# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11328
11329# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11330 ! Data assignment
11331# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11332 select case (num_dims)
11333# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11334 case (1)
11335# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11336 idx = i + 1 + global_offset_x
11337# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11338 do f = 1, sys_size
11339# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11340 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11341# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11342 end do
11343# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11344 case (2)
11345# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11346 idx = i + 1 + global_offset_x - index_x
11347# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11348 do f = 1, sys_size - 1
11349# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11350 jump = merge(1, 0, f >= eqn_idx%mom%end)
11351# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11352 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11353# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11354 end do
11355# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11356 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11357# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11358 case (3)
11359# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11360 idx = i + 1 + global_offset_x - index_x
11361# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11362 idy = j + 1 + global_offset_y - index_y
11363# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11364 do f = 1, sys_size - 1
11365# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11366 jump = merge(1, 0, f >= eqn_idx%mom%end)
11367# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11368 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11369# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11370 end do
11371# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11372 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
11373# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11374 end select
11375# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11376 case (280) ! Isentropic vortex
11377# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11378 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
11379# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11380 ! geometry 2
11381# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11382 if (patch_id == 1) then
11383# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11384 q_prim_vf(eqn_idx%E)%sf(i, j, &
11385# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11386 & 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) &
11387# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11388 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
11389# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11390 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11391# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11392 & 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) &
11393# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11394 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
11395# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11396 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11397# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11398 & 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) &
11399# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11400 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11401# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11402 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11403# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11404 & 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) &
11405# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11406 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11407# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11408 end if
11409# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11410 case (281) ! Acoustic pulse
11411# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11412 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
11413# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11414 ! geometry 2
11415# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11416 if (patch_id == 2) then
11417# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11418 q_prim_vf(eqn_idx%E)%sf(i, j, &
11419# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11420 & 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))
11421# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11422 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11423# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11424 & 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))
11425# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11426 end if
11427# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11428 case (282) ! Zero-circulation vortex
11429# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11430 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
11431# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11432 ! geometry 2
11433# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11434 if (patch_id == 2) then
11435# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11436 q_prim_vf(eqn_idx%E)%sf(i, j, &
11437# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11438 & 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))
11439# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11440 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
11441# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11442 & 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))
11443# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11444 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
11445# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11446 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11447# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11448 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
11449# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11450 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11451# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11452 end if
11453# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11454 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
11455# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11456 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
11457# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11458 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
11459# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11460 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
11461# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11462 ! patch_icpp(patch_id)%epsilon; defaults to 5.
11463# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11464 if (patch_id == 1) then
11465# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11466 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
11467# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11468 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
11469# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11470 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
11471# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11472 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
11473# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11474 do igq = 1, 3
11475# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11476 do jgq = 1, 3
11477# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11478 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
11479# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11480 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
11481# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11482 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
11483# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11484 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))
11485# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11486 wq = gauss_w(igq)*gauss_w(jgq)
11487# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11488 rhoq = t_facq**1.4_wp
11489# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11490 pq = t_facq**2.4_wp
11491# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11492 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11493# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11494 & - r2q)
11495# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11496 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
11497# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11498 & - r2q)
11499# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11500 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
11501# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11502 rho_avg = rho_avg + wq*rhoq
11503# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11504 rhou_avg = rhou_avg + wq*(rhoq*uq)
11505# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11506 rhov_avg = rhov_avg + wq*(rhoq*vq)
11507# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11508 e_avg = e_avg + wq*eq
11509# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11510 end do
11511# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11512 end do
11513# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11514 rho_avg = rho_avg*0.25_wp
11515# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11516 rhou_avg = rhou_avg*0.25_wp
11517# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11518 rhov_avg = rhov_avg*0.25_wp
11519# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11520 e_avg = e_avg*0.25_wp
11521# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11522 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
11523# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11524 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
11525# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11526 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
11527# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11528 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
11529# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11530 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
11531# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11532 end if
11533# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11534 case (291) ! Isothermal Flat Plate
11535# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11536 t_inf = 1125.0_wp
11537# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11538 t_wall = 600.0_wp
11539# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11540 p_atm = 101325.0_wp
11541# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11542
11543# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11544 ! Boundary/Shear Layer thicknesses
11545# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11546 delta_th = 0.0003_wp ! Thermal BL thickness
11547# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11548 delta_shear = 8e-3_wp ! Velocity BL thickness
11549# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11550
11551# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11552 u_max = 50.0_wp ! Freestream Velocity (m/s)
11553# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11554
11555# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11556 mw_n2 = 28.0134e-3_wp
11557# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11558 mw_o2 = 31.999e-3_wp
11559# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11560 y_n2 = 0.767_wp
11561# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11562 y_o2 = 0.233_wp
11563# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11564 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
11565# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11566 bottom_blend_u = tanh(y_cc(j)/delta_shear)
11567# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11568 bottom_blend_t = tanh(y_cc(j)/delta_th)
11569# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11570 u_mean = u_max*bottom_blend_u
11571# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11572 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
11573# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11574 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
11575# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11576 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
11577# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11578 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11579# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11580 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
11581# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11582 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
11583# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11584 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
11585# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11586 case default
11587# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11588 if (proc_rank == 0) then
11589# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11590 call s_int_to_str(patch_id, istr)
11591# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11592 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
11593# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11594 end if
11595# 762 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11596 end select
11597 end if
11598
11599 ! Updating the patch identities bookkeeping variable
11600 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
11601
11602 ! Assign Parameters
11603 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
11604 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
11605 q_prim_vf(eqn_idx%E)%sf(i, j, &
11606 & 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, &
11607 & 0)*u0*u0)/16
11608 end if
11609 end do
11610 end do
11611 if (allocated(stored_values)) then
11612# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11613#ifdef MFC_DEBUG
11614# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11615 block
11616# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11617 use iso_fortran_env, only: output_unit
11618# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11619
11620# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11621 print *, 'm_icpp_patches.fpp:777: ', '@:DEALLOCATE(stored_values)'
11622# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11623
11624# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11625 call flush (output_unit)
11626# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11627 end block
11628# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11629#endif
11630# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11631
11632# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11633#if defined(MFC_OpenACC)
11634# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11635!$acc exit data delete(stored_values)
11636# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11637#elif defined(MFC_OpenMP)
11638# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11639!$omp target exit data map(release:stored_values)
11640# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11641#endif
11642# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11643 deallocate (stored_values)
11644# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11645#ifdef MFC_DEBUG
11646# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11647 block
11648# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11649 use iso_fortran_env, only: output_unit
11650# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11651
11652# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11653 print *, 'm_icpp_patches.fpp:777: ', '@:DEALLOCATE(x_coords)'
11654# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11655
11656# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11657 call flush (output_unit)
11658# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11659 end block
11660# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11661#endif
11662# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11663
11664# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11665#if defined(MFC_OpenACC)
11666# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11667!$acc exit data delete(x_coords)
11668# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11669#elif defined(MFC_OpenMP)
11670# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11671!$omp target exit data map(release:x_coords)
11672# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11673#endif
11674# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11675 deallocate (x_coords)
11676# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11677 end if
11678# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11679
11680# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11681 if (allocated(y_coords)) then
11682# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11683#ifdef MFC_DEBUG
11684# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11685 block
11686# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11687 use iso_fortran_env, only: output_unit
11688# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11689
11690# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11691 print *, 'm_icpp_patches.fpp:777: ', '@:DEALLOCATE(y_coords)'
11692# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11693
11694# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11695 call flush (output_unit)
11696# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11697 end block
11698# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11699#endif
11700# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11701
11702# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11703#if defined(MFC_OpenACC)
11704# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11705!$acc exit data delete(y_coords)
11706# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11707#elif defined(MFC_OpenMP)
11708# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11709!$omp target exit data map(release:y_coords)
11710# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11711#endif
11712# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11713 deallocate (y_coords)
11714# 777 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11715 end if
11716
11717 end subroutine s_icpp_2d_taylorgreen_vortex
11718
11719 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
11720 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
11721
11722 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
11723
11724 ! Patch identifier
11725 integer, intent(in) :: patch_id
11726
11727#ifdef MFC_MIXED_PRECISION
11728 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11729#else
11730 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11731#endif
11732 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11733
11734 ! Generic loop iterators
11735 integer :: i, j, k
11736 ! Placeholders for the cell boundary values
11737 real(wp) :: pi_inf, gamma, lit_gamma
11738
11739 integer :: xRows, yRows, nRows, iix, iiy, max_files
11740# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11741 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11742# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11743 real(wp) :: x_len, x_step, y_len, y_step
11744# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11745 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11746# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11747 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
11748# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11749 real(wp) :: delta_x, delta_y
11750# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11751 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
11752# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11753 character(len=200) :: errmsg
11754# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11755 real(wp), allocatable :: stored_values(:,:,:)
11756# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11757 real(wp), allocatable :: x_coords(:), y_coords(:)
11758# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11759 logical :: files_loaded = .false.
11760# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11761 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11762# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11763 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
11764# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11765 character(len=20) :: file_num_str !< For storing the file number as a string
11766# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11767 character(len=20) :: zeros_part !< For the trailing zeros part
11768# 801 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11769 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
11770 ! Place any declaration of intermediate variables here
11771# 802 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
11773
11774 pi_inf = pi_infs(1)
11775 gamma = gammas(1)
11776 lit_gamma = gs_min(1)
11777
11778 ! Transferring the patch's centroid and length information
11779 x_centroid = patch_icpp(patch_id)%x_centroid
11780 length_x = patch_icpp(patch_id)%length_x
11781
11782 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
11783 x_boundary%beg = x_centroid - 0.5_wp*length_x
11784 x_boundary%end = x_centroid + 0.5_wp*length_x
11785
11786 ! Set eta=1 (no smoothing for this patch type)
11787 eta = 1._wp
11788
11789 ! Assign patch vars if cell is covered and patch has write permission
11790 do i = 0, m
11791 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, &
11792 & 0, 0))) then
11793 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
11794
11795
11796 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11797 select case (patch_icpp(patch_id)%hcid)
11798# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11799 case (150) ! 1D Smooth Alfven Case for MHD
11800# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11801 ! velocity
11802# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11803 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11804# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11805 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11806# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11807
11808# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11809 ! magnetic field
11810# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11811 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11812# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11813 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11814# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11815 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
11816# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11817 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
11818# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11819 ! SDtoolbox)
11820# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11821 if (.not. files_loaded) then
11822# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11823 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11824# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11825 do f = 1, max_files
11826# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11827 write (file_num_str, '(I0)') f
11828# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11829 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
11830# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11831 end do
11832# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11833
11834# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11835 ! Common file reading setup
11836# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11837 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11838# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11839 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11840# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11841
11842# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11843 select case (num_dims)
11844# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11845 case (1, 2) ! 1D and 2D cases are similar
11846# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11847 ! Count lines
11848# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11849 line_count = 0
11850# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11851 do
11852# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11853 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11854# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11855 if (ios2 /= 0) exit
11856# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11857 line_count = line_count + 1
11858# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11859 end do
11860# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11861 close (unit2)
11862# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11863
11864# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11865 xrows = line_count
11866# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11867 yrows = 1
11868# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11869 index_x = 0
11870# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11871 if (num_dims == 2) index_x = i
11872# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11873#ifdef MFC_DEBUG
11874# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11875 block
11876# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11877 use iso_fortran_env, only: output_unit
11878# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11879
11880# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11881 print *, 'm_icpp_patches.fpp:827: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11882# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11883
11884# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11885 call flush (output_unit)
11886# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11887 end block
11888# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11889#endif
11890# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11891 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11892# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11893
11894# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11895
11896# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11897
11898# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11899#if defined(MFC_OpenACC)
11900# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11901!$acc enter data create(x_coords, stored_values)
11902# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11903#elif defined(MFC_OpenMP)
11904# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11905!$omp target enter data map(always,alloc:x_coords, stored_values)
11906# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11907#endif
11908# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11909
11910# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11911 ! Read data from all files
11912# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11913 do f = 1, max_files
11914# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11915 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11916# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11917 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11918# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11919
11920# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11921 do iter = 1, xrows
11922# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11923 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11924# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11925 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11926# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11927 end do
11928# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11929 close (unit)
11930# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11931 end do
11932# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11933
11934# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11935 ! Calculate offsets
11936# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11937 domain_xstart = x_coords(1)
11938# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11939 x_step = x_cc(1) - x_cc(0)
11940# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11941 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)
11942# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11943 global_offset_x = nint(abs(delta_x)/x_step)
11944# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11945 case (3) ! 3D case - determine grid structure
11946# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11947 ! Find yRows by counting rows with same x
11948# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11949 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11950# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11951 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11952# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11953
11954# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11955 yrows = 1
11956# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11957 do
11958# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11959 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11960# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11961 if (ios2 /= 0) exit
11962# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11963 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11964# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11965 yrows = yrows + 1
11966# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11967 else
11968# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11969 exit
11970# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11971 end if
11972# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11973 end do
11974# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11975 close (unit2)
11976# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11977
11978# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11979 ! Count total rows
11980# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11981 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11982# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11983 nrows = 0
11984# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11985 do
11986# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11987 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11988# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11989 if (ios2 /= 0) exit
11990# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11991 nrows = nrows + 1
11992# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11993 end do
11994# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11995 close (unit2)
11996# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11997
11998# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11999 xrows = nrows/yrows
12000# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12001#ifdef MFC_DEBUG
12002# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12003 block
12004# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12005 use iso_fortran_env, only: output_unit
12006# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12007
12008# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12009 print *, 'm_icpp_patches.fpp:827: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12010# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12011
12012# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12013 call flush (output_unit)
12014# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12015 end block
12016# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12017#endif
12018# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12019 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12020# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12021
12022# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12023
12024# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12025
12026# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12027
12028# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12029#if defined(MFC_OpenACC)
12030# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12031!$acc enter data create(x_coords, y_coords, stored_values)
12032# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12033#elif defined(MFC_OpenMP)
12034# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12035!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12036# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12037#endif
12038# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12039 index_x = i
12040# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12041 index_y = j
12042# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12043
12044# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12045 ! Read all files
12046# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12047 do f = 1, max_files
12048# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12049 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12050# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12051 if (ios /= 0) then
12052# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12053 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12054# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12055 cycle
12056# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12057 end if
12058# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12059
12060# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12061 iter = 0
12062# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12063 do iix = 1, xrows
12064# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12065 do iiy = 1, yrows
12066# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12067 iter = iter + 1
12068# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12069 if (f == 1) then
12070# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12071 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12072# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12073 else
12074# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12075 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12076# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12077 end if
12078# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12079 if (ios /= 0) call s_mpi_abort("Error reading data")
12080# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12081 end do
12082# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12083 end do
12084# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12085 close (unit)
12086# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12087 end do
12088# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12089
12090# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12091 ! Calculate offsets
12092# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12093 x_step = x_cc(1) - x_cc(0)
12094# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12095 y_step = y_cc(1) - y_cc(0)
12096# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12097 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12098# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12099 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12100# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12101 global_offset_x = nint(abs(delta_x)/x_step)
12102# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12103 global_offset_y = nint(abs(delta_y)/y_step)
12104# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12105 end select
12106# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12107
12108# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12109 files_loaded = .true.
12110# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12111 end if
12112# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12113
12114# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12115 ! Data assignment
12116# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12117 select case (num_dims)
12118# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12119 case (1)
12120# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12121 idx = i + 1 + global_offset_x
12122# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12123 do f = 1, sys_size
12124# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12125 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12126# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12127 end do
12128# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12129 case (2)
12130# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12131 idx = i + 1 + global_offset_x - index_x
12132# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12133 do f = 1, sys_size - 1
12134# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12135 jump = merge(1, 0, f >= eqn_idx%mom%end)
12136# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12137 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12138# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12139 end do
12140# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12141 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
12142# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12143 case (3)
12144# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12145 idx = i + 1 + global_offset_x - index_x
12146# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12147 idy = j + 1 + global_offset_y - index_y
12148# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12149 do f = 1, sys_size - 1
12150# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12151 jump = merge(1, 0, f >= eqn_idx%mom%end)
12152# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12153 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12154# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12155 end do
12156# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12157 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
12158# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12159 end select
12160# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12161 case (180) ! Shu-Osher problem
12162# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12163 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
12164# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12165 ! 0.2*sin(5*x)"
12166# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12167 if (patch_id == 2) then
12168# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12169 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
12170# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12171 end if
12172# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12173 case (181) ! Titarev-Torro problem
12174# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12175 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
12176# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12177 ! "1 + 0.1*sin(20*x*pi)"
12178# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12179 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
12180# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12181 case (182) ! Multi-component diffusion
12182# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12183 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
12184# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12185 x_mid_diffu = 0.05_wp/2.0_wp
12186# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12187 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
12188# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12189 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
12190# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12191 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12192# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12193 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
12194# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12195 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
12196# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12197
12198# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12199 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
12200# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12201 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
12202# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12203 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
12204# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12205 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
12206# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12207
12208# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12209 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
12210# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12211 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
12212# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12213 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
12214# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12215 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
12216# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12217
12218# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12219 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
12220# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12221
12222# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12223 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
12224# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12225
12226# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12227 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)
12228# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12229
12230# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12231 case(191) ! 1D Dual Isothermal case
12232# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12233
12234# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12235 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
12236# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12237 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
12238# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12239 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
12240# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12241
12242# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12243 if (x_cc(i) <= 0.025_wp) then
12244# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12245 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
12246# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12247 else
12248# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12249 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
12250# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12251 end if
12252# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12253
12254# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12255 molar_mass_inv = 1.0_wp/2.01588_wp
12256# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12257 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
12258# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12259 case default
12260# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12261 call s_int_to_str(patch_id, istr)
12262# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12263 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
12264# 827 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12265 end select
12266 end if
12267 end if
12268 end do
12269 if (allocated(stored_values)) then
12270# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12271#ifdef MFC_DEBUG
12272# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12273 block
12274# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12275 use iso_fortran_env, only: output_unit
12276# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12277
12278# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12279 print *, 'm_icpp_patches.fpp:831: ', '@:DEALLOCATE(stored_values)'
12280# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12281
12282# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12283 call flush (output_unit)
12284# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12285 end block
12286# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12287#endif
12288# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12289
12290# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12291#if defined(MFC_OpenACC)
12292# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12293!$acc exit data delete(stored_values)
12294# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12295#elif defined(MFC_OpenMP)
12296# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12297!$omp target exit data map(release:stored_values)
12298# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12299#endif
12300# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12301 deallocate (stored_values)
12302# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12303#ifdef MFC_DEBUG
12304# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12305 block
12306# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12307 use iso_fortran_env, only: output_unit
12308# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12309
12310# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12311 print *, 'm_icpp_patches.fpp:831: ', '@:DEALLOCATE(x_coords)'
12312# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12313
12314# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12315 call flush (output_unit)
12316# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12317 end block
12318# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12319#endif
12320# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12321
12322# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12323#if defined(MFC_OpenACC)
12324# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12325!$acc exit data delete(x_coords)
12326# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12327#elif defined(MFC_OpenMP)
12328# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12329!$omp target exit data map(release:x_coords)
12330# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12331#endif
12332# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12333 deallocate (x_coords)
12334# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12335 end if
12336# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12337
12338# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12339 if (allocated(y_coords)) then
12340# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12341#ifdef MFC_DEBUG
12342# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12343 block
12344# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12345 use iso_fortran_env, only: output_unit
12346# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12347
12348# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12349 print *, 'm_icpp_patches.fpp:831: ', '@:DEALLOCATE(y_coords)'
12350# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12351
12352# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12353 call flush (output_unit)
12354# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12355 end block
12356# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12357#endif
12358# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12359
12360# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12361#if defined(MFC_OpenACC)
12362# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12363!$acc exit data delete(y_coords)
12364# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12365#elif defined(MFC_OpenMP)
12366# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12367!$omp target exit data map(release:y_coords)
12368# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12369#endif
12370# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12371 deallocate (y_coords)
12372# 831 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12373 end if
12374
12375 end subroutine s_icpp_1d_bubble_pulse
12376
12377 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
12378 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
12379 !! 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);
12380 !! coefficients are relative (dimensionless).
12381 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
12382
12383 integer, intent(in) :: patch_id
12384
12385#ifdef MFC_MIXED_PRECISION
12386 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12387#else
12388 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12389#endif
12390 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12391 real(wp) :: r, theta, R_boundary, sum_series
12392 integer :: i, j, nn
12393
12394 x_centroid = patch_icpp(patch_id)%x_centroid
12395 y_centroid = patch_icpp(patch_id)%y_centroid
12396 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12397 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12398 eta = 1._wp
12399
12400 do j = 0, n
12401 do i = 0, m
12402 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
12403 if (r < small_radius) then
12404 theta = 0._wp
12405 else
12406 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
12407 end if
12408 sum_series = 0._wp
12409 do nn = 1, max_2d_fourier_modes
12410 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
12411 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
12412 end do
12413 if (patch_icpp(patch_id)%modal_use_exp_form) then
12414 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
12415 else
12416 r_boundary = patch_icpp(patch_id)%radius + sum_series
12417 r_boundary = max(r_boundary, 0._wp)
12418 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
12419 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
12420 end if
12421 end if
12422 if (patch_icpp(patch_id)%smoothen) then
12423 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy)*(r_boundary - r))
12424 end if
12425 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
12426 & 0) == smooth_patch_id) then
12427 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
12428 end if
12429 end do
12430 end do
12431
12432 end subroutine s_icpp_2d_modal
12433
12434 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
12435 !! atan2(y,x) relative to centroid.
12436 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
12437
12438 integer, intent(in) :: patch_id
12439
12440#ifdef MFC_MIXED_PRECISION
12441 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12442#else
12443 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12444#endif
12445 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12446 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
12447 integer :: i, j, k, ll, mm
12448
12449 x_centroid = patch_icpp(patch_id)%x_centroid
12450 y_centroid = patch_icpp(patch_id)%y_centroid
12451 z_centroid = patch_icpp(patch_id)%z_centroid
12452 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12453 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12454 eta_local = 1._wp
12455
12456 do k = 0, p
12457 do j = 0, n
12458 do i = 0, m
12459 if (grid_geometry == 3) then
12460 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12461 dx_loc = x_cc(i) - x_centroid
12462 dy_loc = cart_y - y_centroid
12463 dz_loc = cart_z - z_centroid
12464 else
12465 dx_loc = x_cc(i) - x_centroid
12466 dy_loc = y_cc(j) - y_centroid
12467 dz_loc = z_cc(k) - z_centroid
12468 end if
12469 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
12470 if (r < small_radius) then
12471 theta = 0._wp
12472 phi = 0._wp
12473 else
12474 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
12475 phi = atan2(dy_loc, dx_loc)
12476 end if
12477 r_surface = patch_icpp(patch_id)%radius
12478 do ll = 0, max_sph_harm_degree
12479 do mm = -ll, ll
12480 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
12481 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
12482 end do
12483 end do
12484 if (patch_icpp(patch_id)%smoothen) then
12485 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy, dz)*(r_surface - r))
12486 end if
12487 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12488 & k) == smooth_patch_id) then
12489 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
12490 end if
12491 end do
12492 end do
12493 end do
12494
12495 end subroutine s_icpp_3d_spherical_harmonic
12496
12497 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
12498 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
12499 !! its boundary.
12500 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
12501
12502 integer, intent(in) :: patch_id
12503
12504#ifdef MFC_MIXED_PRECISION
12505 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12506#else
12507 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12508#endif
12509 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12510
12511 ! Generic loop iterators
12512 integer :: i, j, k
12513 real(wp) :: radius
12514
12515 integer :: xRows, yRows, nRows, iix, iiy, max_files
12516# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12517 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12518# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12519 real(wp) :: x_len, x_step, y_len, y_step
12520# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12521 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12522# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12523 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
12524# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12525 real(wp) :: delta_x, delta_y
12526# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12527 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
12528# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12529 character(len=200) :: errmsg
12530# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12531 real(wp), allocatable :: stored_values(:,:,:)
12532# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12533 real(wp), allocatable :: x_coords(:), y_coords(:)
12534# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12535 logical :: files_loaded = .false.
12536# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12537 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12538# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12539 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
12540# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12541 character(len=20) :: file_num_str !< For storing the file number as a string
12542# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12543 character(len=20) :: zeros_part !< For the trailing zeros part
12544# 973 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12545 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
12546 ! Place any declaration of intermediate variables here
12547# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12549# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 real(wp) :: eps
12551# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12552
12553# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12554 ! IGR Jets Arrays to stor position and radii of jets from input file
12555# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12556 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12557# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12558 ! Variables to describe initial condition of jet
12559# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12560 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12561# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12562 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
12563# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12564 real(wp), dimension(0:n,0:p) :: rcut_arr
12565# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12566 integer :: l, q, s !< Iterators for reading input files
12567# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12568 integer :: start, end !< Ints to keep track of position in file
12569# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12570 character(len=1000) :: line !< String to store line in file
12571# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12572 character(len=25) :: value !< String to store value in line
12573# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12574 integer :: NJet !< Number of jets
12575# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12576
12577# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12578 eps = 1e-9_wp
12579# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12580
12581# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12582 if (patch_icpp(patch_id)%hcid == 303) then
12583# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12584 eps_smooth = 3._wp
12585# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12586 open (unit=10, file="njet.txt", status="old", action="read")
12587# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12588 read (10, *) njet
12589# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12590 close (10)
12591# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12592
12593# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12594 allocate (y_th_arr(0:njet - 1))
12595# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12596 allocate (z_th_arr(0:njet - 1))
12597# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12598 allocate (r_th_arr(0:njet - 1))
12599# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12600
12601# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12602 open (unit=10, file="jets.csv", status="old", action="read")
12603# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12604 do q = 0, njet - 1
12605# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12606 read (10, '(A)') line ! Read a full line as a string
12607# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12608 start = 1
12609# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12610
12611# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12612 do l = 0, 2
12613# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12614 end = index(line(start:), ',') ! Find the next comma
12615# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12616 if (end == 0) then
12617# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12618 value = trim(adjustl(line(start:))) ! Last value in the line
12619# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12620 else
12621# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12622 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12623# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12624 start = start + end ! Move to next value
12625# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12626 end if
12627# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12628 if (l == 0) then
12629# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12630 read (value, *) y_th_arr(q) ! Convert string to numeric value
12631# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12632 else if (l == 1) then
12633# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12634 read (value, *) z_th_arr(q)
12635# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12636 else
12637# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12638 read (value, *) r_th_arr(q)
12639# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12640 end if
12641# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12642 end do
12643# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12644 end do
12645# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12646 close (10)
12647# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12648
12649# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12650 do q = 0, p
12651# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12652 do l = 0, n
12653# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12654 rcut = 0._wp
12655# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12656 do s = 0, njet - 1
12657# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12658 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12659# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12660 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12661# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12662 end do
12663# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12664 rcut_arr(l, q) = rcut
12665# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12666 end do
12667# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12668 end do
12669# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12670 end if
12671
12672 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
12673
12674 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
12675 x_centroid = patch_icpp(patch_id)%x_centroid
12676 y_centroid = patch_icpp(patch_id)%y_centroid
12677 z_centroid = patch_icpp(patch_id)%z_centroid
12678 radius = patch_icpp(patch_id)%radius
12679 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12680 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12681
12682 ! Initialize eta=1; modified if smoothing is enabled
12683 eta = 1._wp
12684
12685 ! Assign patch vars if cell is covered and patch has write permission
12686 do k = 0, p
12687 do j = 0, n
12688 do i = 0, m
12689 if (grid_geometry == 3) then
12690 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12691 else
12692 cart_y = y_cc(j)
12693 cart_z = z_cc(k)
12694 end if
12695
12696 if (patch_icpp(patch_id)%smoothen) then
12697 eta = tanh(smooth_coeff/min(dx, dy, &
12698 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) &
12699 & - radius))*(-0.5_wp) + 0.5_wp
12700 end if
12701
12702 if ((((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2) &
12703 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
12704 & k) == smooth_patch_id) then
12705 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
12706
12707
12708 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12709 select case (patch_icpp(patch_id)%hcid)
12710# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12711 case (300) ! Rayleigh-Taylor instability
12712# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12713 rhoh = 3._wp
12714# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12715 rhol = 1._wp
12716# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12717 pref = 1.e5_wp
12718# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12719 pint = pref
12720# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12721 h = 0.7_wp
12722# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12723 lam = 0.2_wp
12724# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12725 wl = 2._wp*pi/lam
12726# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12727 amp = 0.025_wp/wl
12728# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12729
12730# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12731 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
12732# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12733
12734# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12735 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12736# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12737
12738# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12739 if (alph < eps) alph = eps
12740# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12741 if (alph > 1._wp - eps) alph = 1._wp - eps
12742# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12743
12744# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12745 if (y_cc(j) > inth) then
12746# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12747 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12748# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12749 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12750# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12751 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12752# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12753 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12754# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12755 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12756# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12757 else
12758# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12759 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
12760# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12761 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
12762# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12763 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
12764# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12765 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
12766# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12767 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12768# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12769 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12770# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12771 end if
12772# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12773 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12774# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12775 h = 0.0_wp
12776# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12777 lam = 1.0_wp
12778# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12779 amp = patch_icpp(patch_id)%a(2)
12780# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12781 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12782# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12783 if (x_cc(i) > inth) then
12784# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12785 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12786# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12787 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12788# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12789 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
12790# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12791 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12792# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12793 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12794# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12795 end if
12796# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12797 case (302) ! 3D Jet with IGR
12798# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12799 ux_th = 10*sqrt(1.4*0.4)
12800# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12801 ux_am = 0.0*sqrt(1.4)
12802# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12803 p_th = 2.0_wp
12804# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12805 p_am = 1.0_wp
12806# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12807 rho_th = 1._wp
12808# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12809 rho_am = 1._wp
12810# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12811 y_th = 0.0_wp
12812# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12813 z_th = 0.0_wp
12814# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12815 r_th = 1._wp
12816# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12817 eps_smooth = 1._wp
12818# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12819 eps = 1e-6
12820# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12821
12822# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12823 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12824# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12825 rcut = f_cut_on(r - r_th, eps_smooth)
12826# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12827 xcut = f_cut_on(x_cc(i), eps_smooth)
12828# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12829
12830# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12831 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12832# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12833 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12834# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12835 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12836# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12837
12838# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12839 if (num_fluids == 1) then
12840# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12841 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12842# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12843 else
12844# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12845 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12846# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12847 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12848# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12849 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))
12850# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12851 end if
12852# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12853
12854# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12855 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12856# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12857 case (303) ! 3D Multijet
12858# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12859 eps_smooth = 3.0_wp
12860# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12861 ux_th = 10*sqrt(1.4*0.4)
12862# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12863 ux_am = 2.5*sqrt(1.4*0.4)
12864# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12865 p_th = 0.8_wp
12866# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12867 p_am = 0.4_wp
12868# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12869 rho_th = 1._wp
12870# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12871 rho_am = 1._wp
12872# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12873 eps = 1e-6
12874# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12875
12876# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12877 rcut = rcut_arr(j, k)
12878# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12879 xcut = f_cut_on(x_cc(i), eps_smooth)
12880# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12881
12882# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12883 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12884# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12885 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
12886# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12887 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
12888# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12889
12890# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12891 if (num_fluids == 1) then
12892# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12893 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12894# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12895 else
12896# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12897 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12898# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12899 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
12900# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12901 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))
12902# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12903 end if
12904# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12905
12906# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12907 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
12908# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12909 case (370) ! 3D extrusion of 2D profile from external data
12910# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12911 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12912# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12913 if (.not. files_loaded) then
12914# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12915 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12916# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12917 do f = 1, max_files
12918# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12919 write (file_num_str, '(I0)') f
12920# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12921 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
12922# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12923 end do
12924# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12925
12926# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12927 ! Common file reading setup
12928# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12929 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12930# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12931 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12932# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12933
12934# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12935 select case (num_dims)
12936# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12937 case (1, 2) ! 1D and 2D cases are similar
12938# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12939 ! Count lines
12940# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12941 line_count = 0
12942# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12943 do
12944# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12945 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12946# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12947 if (ios2 /= 0) exit
12948# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12949 line_count = line_count + 1
12950# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12951 end do
12952# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12953 close (unit2)
12954# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12955
12956# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12957 xrows = line_count
12958# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12959 yrows = 1
12960# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12961 index_x = 0
12962# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12963 if (num_dims == 2) index_x = i
12964# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12965#ifdef MFC_DEBUG
12966# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12967 block
12968# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12969 use iso_fortran_env, only: output_unit
12970# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12971
12972# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12973 print *, 'm_icpp_patches.fpp:1013: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12974# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12975
12976# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12977 call flush (output_unit)
12978# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12979 end block
12980# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12981#endif
12982# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12983 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12984# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12985
12986# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12987
12988# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12989
12990# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12991#if defined(MFC_OpenACC)
12992# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12993!$acc enter data create(x_coords, stored_values)
12994# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12995#elif defined(MFC_OpenMP)
12996# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12997!$omp target enter data map(always,alloc:x_coords, stored_values)
12998# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12999#endif
13000# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13001
13002# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13003 ! Read data from all files
13004# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13005 do f = 1, max_files
13006# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13007 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13008# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13009 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13010# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13011
13012# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13013 do iter = 1, xrows
13014# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13015 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13016# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13017 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13018# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13019 end do
13020# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13021 close (unit)
13022# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13023 end do
13024# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13025
13026# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13027 ! Calculate offsets
13028# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13029 domain_xstart = x_coords(1)
13030# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13031 x_step = x_cc(1) - x_cc(0)
13032# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13033 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)
13034# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13035 global_offset_x = nint(abs(delta_x)/x_step)
13036# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13037 case (3) ! 3D case - determine grid structure
13038# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13039 ! Find yRows by counting rows with same x
13040# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13041 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13042# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13043 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13044# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13045
13046# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13047 yrows = 1
13048# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13049 do
13050# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13051 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13052# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13053 if (ios2 /= 0) exit
13054# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13055 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13056# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13057 yrows = yrows + 1
13058# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13059 else
13060# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13061 exit
13062# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13063 end if
13064# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13065 end do
13066# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13067 close (unit2)
13068# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13069
13070# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13071 ! Count total rows
13072# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13073 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13074# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13075 nrows = 0
13076# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13077 do
13078# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13079 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13080# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13081 if (ios2 /= 0) exit
13082# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13083 nrows = nrows + 1
13084# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13085 end do
13086# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13087 close (unit2)
13088# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13089
13090# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13091 xrows = nrows/yrows
13092# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13093#ifdef MFC_DEBUG
13094# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13095 block
13096# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13097 use iso_fortran_env, only: output_unit
13098# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13099
13100# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13101 print *, 'm_icpp_patches.fpp:1013: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13102# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13103
13104# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13105 call flush (output_unit)
13106# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13107 end block
13108# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13109#endif
13110# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13111 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13112# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13113
13114# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13115
13116# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13117
13118# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13119
13120# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13121#if defined(MFC_OpenACC)
13122# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13123!$acc enter data create(x_coords, y_coords, stored_values)
13124# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13125#elif defined(MFC_OpenMP)
13126# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13127!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13128# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13129#endif
13130# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13131 index_x = i
13132# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13133 index_y = j
13134# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13135
13136# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13137 ! Read all files
13138# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13139 do f = 1, max_files
13140# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13141 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13142# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13143 if (ios /= 0) then
13144# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13145 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13146# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13147 cycle
13148# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13149 end if
13150# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13151
13152# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13153 iter = 0
13154# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13155 do iix = 1, xrows
13156# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13157 do iiy = 1, yrows
13158# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13159 iter = iter + 1
13160# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13161 if (f == 1) then
13162# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13163 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13164# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13165 else
13166# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13167 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13168# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13169 end if
13170# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13171 if (ios /= 0) call s_mpi_abort("Error reading data")
13172# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13173 end do
13174# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13175 end do
13176# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13177 close (unit)
13178# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13179 end do
13180# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13181
13182# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13183 ! Calculate offsets
13184# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13185 x_step = x_cc(1) - x_cc(0)
13186# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13187 y_step = y_cc(1) - y_cc(0)
13188# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13189 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13190# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13191 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13192# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13193 global_offset_x = nint(abs(delta_x)/x_step)
13194# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13195 global_offset_y = nint(abs(delta_y)/y_step)
13196# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13197 end select
13198# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13199
13200# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13201 files_loaded = .true.
13202# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13203 end if
13204# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13205
13206# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13207 ! Data assignment
13208# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13209 select case (num_dims)
13210# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13211 case (1)
13212# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13213 idx = i + 1 + global_offset_x
13214# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13215 do f = 1, sys_size
13216# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13217 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13218# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13219 end do
13220# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13221 case (2)
13222# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13223 idx = i + 1 + global_offset_x - index_x
13224# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13225 do f = 1, sys_size - 1
13226# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13227 jump = merge(1, 0, f >= eqn_idx%mom%end)
13228# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13229 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13230# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13231 end do
13232# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13233 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13234# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13235 case (3)
13236# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13237 idx = i + 1 + global_offset_x - index_x
13238# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13239 idy = j + 1 + global_offset_y - index_y
13240# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13241 do f = 1, sys_size - 1
13242# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13243 jump = merge(1, 0, f >= eqn_idx%mom%end)
13244# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13245 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13246# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13247 end do
13248# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13249 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13250# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13251 end select
13252# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13253 case (380) ! Taylor-Green vortex
13254# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13255 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
13256# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13257 ! geometry 9
13258# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13259 mach = 0.1
13260# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13261 if (patch_id == 1) then
13262# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13263 q_prim_vf(eqn_idx%E)%sf(i, j, &
13264# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13265 & 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)
13266# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13267 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)
13268# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13269 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)
13270# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13271 end if
13272# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13273 case default
13274# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13275 call s_int_to_str(patch_id, istr)
13276# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13277 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
13278# 1013 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13279 end select
13280 end if
13281 end if
13282 end do
13283 end do
13284 end do
13285 if (allocated(stored_values)) then
13286# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13287#ifdef MFC_DEBUG
13288# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13289 block
13290# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13291 use iso_fortran_env, only: output_unit
13292# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13293
13294# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13295 print *, 'm_icpp_patches.fpp:1019: ', '@:DEALLOCATE(stored_values)'
13296# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13297
13298# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13299 call flush (output_unit)
13300# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13301 end block
13302# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13303#endif
13304# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13305
13306# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13307#if defined(MFC_OpenACC)
13308# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13309!$acc exit data delete(stored_values)
13310# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13311#elif defined(MFC_OpenMP)
13312# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13313!$omp target exit data map(release:stored_values)
13314# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13315#endif
13316# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13317 deallocate (stored_values)
13318# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13319#ifdef MFC_DEBUG
13320# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13321 block
13322# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13323 use iso_fortran_env, only: output_unit
13324# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13325
13326# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13327 print *, 'm_icpp_patches.fpp:1019: ', '@:DEALLOCATE(x_coords)'
13328# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13329
13330# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13331 call flush (output_unit)
13332# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13333 end block
13334# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13335#endif
13336# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13337
13338# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13339#if defined(MFC_OpenACC)
13340# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13341!$acc exit data delete(x_coords)
13342# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13343#elif defined(MFC_OpenMP)
13344# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13345!$omp target exit data map(release:x_coords)
13346# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13347#endif
13348# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13349 deallocate (x_coords)
13350# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13351 end if
13352# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13353
13354# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13355 if (allocated(y_coords)) then
13356# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13357#ifdef MFC_DEBUG
13358# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13359 block
13360# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13361 use iso_fortran_env, only: output_unit
13362# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13363
13364# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13365 print *, 'm_icpp_patches.fpp:1019: ', '@:DEALLOCATE(y_coords)'
13366# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13367
13368# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13369 call flush (output_unit)
13370# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13371 end block
13372# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13373#endif
13374# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13375
13376# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13377#if defined(MFC_OpenACC)
13378# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13379!$acc exit data delete(y_coords)
13380# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13381#elif defined(MFC_OpenMP)
13382# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13383!$omp target exit data map(release:y_coords)
13384# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13385#endif
13386# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13387 deallocate (y_coords)
13388# 1019 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13389 end if
13390
13391 end subroutine s_icpp_sphere
13392
13393 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
13394 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
13395 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
13396 !! allow for the smearing of its boundaries.
13397 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
13398
13399 integer, intent(in) :: patch_id
13400
13401#ifdef MFC_MIXED_PRECISION
13402 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13403#else
13404 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13405#endif
13406 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13407 integer :: i, j, k !< Generic loop iterators
13408
13409 integer :: xRows, yRows, nRows, iix, iiy, max_files
13410# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13411 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13412# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13413 real(wp) :: x_len, x_step, y_len, y_step
13414# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13415 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13416# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13417 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
13418# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13419 real(wp) :: delta_x, delta_y
13420# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13421 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
13422# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13423 character(len=200) :: errmsg
13424# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13425 real(wp), allocatable :: stored_values(:,:,:)
13426# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13427 real(wp), allocatable :: x_coords(:), y_coords(:)
13428# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13429 logical :: files_loaded = .false.
13430# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13431 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13432# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13433 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
13434# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13435 character(len=20) :: file_num_str !< For storing the file number as a string
13436# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13437 character(len=20) :: zeros_part !< For the trailing zeros part
13438# 1039 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13439 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
13440 ! Place any declaration of intermediate variables here
13441# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13443# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 real(wp) :: eps
13445# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13446
13447# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13448 ! IGR Jets Arrays to stor position and radii of jets from input file
13449# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13450 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13451# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13452 ! Variables to describe initial condition of jet
13453# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13454 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13455# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13456 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
13457# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13458 real(wp), dimension(0:n,0:p) :: rcut_arr
13459# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13460 integer :: l, q, s !< Iterators for reading input files
13461# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13462 integer :: start, end !< Ints to keep track of position in file
13463# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13464 character(len=1000) :: line !< String to store line in file
13465# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13466 character(len=25) :: value !< String to store value in line
13467# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13468 integer :: NJet !< Number of jets
13469# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13470
13471# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13472 eps = 1e-9_wp
13473# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13474
13475# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13476 if (patch_icpp(patch_id)%hcid == 303) then
13477# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13478 eps_smooth = 3._wp
13479# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13480 open (unit=10, file="njet.txt", status="old", action="read")
13481# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13482 read (10, *) njet
13483# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13484 close (10)
13485# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13486
13487# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13488 allocate (y_th_arr(0:njet - 1))
13489# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13490 allocate (z_th_arr(0:njet - 1))
13491# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13492 allocate (r_th_arr(0:njet - 1))
13493# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13494
13495# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13496 open (unit=10, file="jets.csv", status="old", action="read")
13497# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13498 do q = 0, njet - 1
13499# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13500 read (10, '(A)') line ! Read a full line as a string
13501# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13502 start = 1
13503# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13504
13505# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13506 do l = 0, 2
13507# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13508 end = index(line(start:), ',') ! Find the next comma
13509# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13510 if (end == 0) then
13511# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13512 value = trim(adjustl(line(start:))) ! Last value in the line
13513# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13514 else
13515# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13516 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13517# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13518 start = start + end ! Move to next value
13519# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13520 end if
13521# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13522 if (l == 0) then
13523# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13524 read (value, *) y_th_arr(q) ! Convert string to numeric value
13525# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13526 else if (l == 1) then
13527# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13528 read (value, *) z_th_arr(q)
13529# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13530 else
13531# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13532 read (value, *) r_th_arr(q)
13533# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13534 end if
13535# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13536 end do
13537# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13538 end do
13539# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13540 close (10)
13541# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13542
13543# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13544 do q = 0, p
13545# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13546 do l = 0, n
13547# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13548 rcut = 0._wp
13549# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13550 do s = 0, njet - 1
13551# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13552 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13553# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13554 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13555# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13556 end do
13557# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13558 rcut_arr(l, q) = rcut
13559# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13560 end do
13561# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13562 end do
13563# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13564 end if
13565
13566 ! Transferring the cuboid's centroid and length information
13567 x_centroid = patch_icpp(patch_id)%x_centroid
13568 y_centroid = patch_icpp(patch_id)%y_centroid
13569 z_centroid = patch_icpp(patch_id)%z_centroid
13570 length_x = patch_icpp(patch_id)%length_x
13571 length_y = patch_icpp(patch_id)%length_y
13572 length_z = patch_icpp(patch_id)%length_z
13573
13574 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
13575 x_boundary%beg = x_centroid - 0.5_wp*length_x
13576 x_boundary%end = x_centroid + 0.5_wp*length_x
13577 y_boundary%beg = y_centroid - 0.5_wp*length_y
13578 y_boundary%end = y_centroid + 0.5_wp*length_y
13579 z_boundary%beg = z_centroid - 0.5_wp*length_z
13580 z_boundary%end = z_centroid + 0.5_wp*length_z
13581
13582 ! Set eta=1 (no smoothing for this patch type)
13583 eta = 1._wp
13584
13585 ! Assign patch vars if cell is covered and patch has write permission
13586 do k = 0, p
13587 do j = 0, n
13588 do i = 0, m
13589 if (grid_geometry == 3) then
13590 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
13591 else
13592 cart_y = y_cc(j)
13593 cart_z = z_cc(k)
13594 end if
13595
13596 if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= cart_y &
13597 & .and. y_boundary%end >= cart_y .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) then
13598 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
13599 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
13600
13601
13602 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13603 select case (patch_icpp(patch_id)%hcid)
13604# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13605 case (300) ! Rayleigh-Taylor instability
13606# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13607 rhoh = 3._wp
13608# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13609 rhol = 1._wp
13610# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13611 pref = 1.e5_wp
13612# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13613 pint = pref
13614# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13615 h = 0.7_wp
13616# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13617 lam = 0.2_wp
13618# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13619 wl = 2._wp*pi/lam
13620# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13621 amp = 0.025_wp/wl
13622# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13623
13624# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13625 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
13626# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13627
13628# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13629 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13630# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13631
13632# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13633 if (alph < eps) alph = eps
13634# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13635 if (alph > 1._wp - eps) alph = 1._wp - eps
13636# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13637
13638# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13639 if (y_cc(j) > inth) then
13640# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13641 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13642# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13643 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13644# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13645 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13646# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13647 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13648# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13649 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13650# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13651 else
13652# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13653 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
13654# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13655 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
13656# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13657 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
13658# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13659 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
13660# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13661 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13662# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13663 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13664# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13665 end if
13666# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13667 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13668# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13669 h = 0.0_wp
13670# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13671 lam = 1.0_wp
13672# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13673 amp = patch_icpp(patch_id)%a(2)
13674# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13675 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13676# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13677 if (x_cc(i) > inth) then
13678# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13679 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13680# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13681 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13682# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13683 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
13684# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13685 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13686# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13687 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13688# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13689 end if
13690# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13691 case (302) ! 3D Jet with IGR
13692# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13693 ux_th = 10*sqrt(1.4*0.4)
13694# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13695 ux_am = 0.0*sqrt(1.4)
13696# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13697 p_th = 2.0_wp
13698# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13699 p_am = 1.0_wp
13700# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13701 rho_th = 1._wp
13702# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13703 rho_am = 1._wp
13704# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13705 y_th = 0.0_wp
13706# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13707 z_th = 0.0_wp
13708# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13709 r_th = 1._wp
13710# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13711 eps_smooth = 1._wp
13712# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13713 eps = 1e-6
13714# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13715
13716# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13717 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13718# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13719 rcut = f_cut_on(r - r_th, eps_smooth)
13720# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13721 xcut = f_cut_on(x_cc(i), eps_smooth)
13722# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13723
13724# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13725 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13726# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13727 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13728# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13729 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13730# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13731
13732# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13733 if (num_fluids == 1) then
13734# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13735 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13736# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13737 else
13738# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13739 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13740# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13741 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13742# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13743 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))
13744# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13745 end if
13746# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13747
13748# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13749 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13750# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13751 case (303) ! 3D Multijet
13752# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13753 eps_smooth = 3.0_wp
13754# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13755 ux_th = 10*sqrt(1.4*0.4)
13756# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13757 ux_am = 2.5*sqrt(1.4*0.4)
13758# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13759 p_th = 0.8_wp
13760# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13761 p_am = 0.4_wp
13762# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13763 rho_th = 1._wp
13764# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13765 rho_am = 1._wp
13766# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13767 eps = 1e-6
13768# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13769
13770# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13771 rcut = rcut_arr(j, k)
13772# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13773 xcut = f_cut_on(x_cc(i), eps_smooth)
13774# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13775
13776# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13777 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13778# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13779 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
13780# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13781 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
13782# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13783
13784# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13785 if (num_fluids == 1) then
13786# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13787 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13788# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13789 else
13790# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13791 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13792# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13793 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
13794# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13795 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))
13796# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13797 end if
13798# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13799
13800# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13801 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
13802# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13803 case (370) ! 3D extrusion of 2D profile from external data
13804# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13805 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13806# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13807 if (.not. files_loaded) then
13808# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13809 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13810# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13811 do f = 1, max_files
13812# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13813 write (file_num_str, '(I0)') f
13814# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13815 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
13816# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13817 end do
13818# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13819
13820# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13821 ! Common file reading setup
13822# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13823 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13824# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13825 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13826# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13827
13828# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13829 select case (num_dims)
13830# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13831 case (1, 2) ! 1D and 2D cases are similar
13832# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13833 ! Count lines
13834# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13835 line_count = 0
13836# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13837 do
13838# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13839 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13840# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13841 if (ios2 /= 0) exit
13842# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13843 line_count = line_count + 1
13844# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13845 end do
13846# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13847 close (unit2)
13848# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13849
13850# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13851 xrows = line_count
13852# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13853 yrows = 1
13854# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13855 index_x = 0
13856# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13857 if (num_dims == 2) index_x = i
13858# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13859#ifdef MFC_DEBUG
13860# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13861 block
13862# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13863 use iso_fortran_env, only: output_unit
13864# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13865
13866# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13867 print *, 'm_icpp_patches.fpp:1079: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13868# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13869
13870# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13871 call flush (output_unit)
13872# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13873 end block
13874# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13875#endif
13876# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13877 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13878# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13879
13880# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13881
13882# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13883
13884# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13885#if defined(MFC_OpenACC)
13886# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13887!$acc enter data create(x_coords, stored_values)
13888# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13889#elif defined(MFC_OpenMP)
13890# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13891!$omp target enter data map(always,alloc:x_coords, stored_values)
13892# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13893#endif
13894# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13895
13896# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13897 ! Read data from all files
13898# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13899 do f = 1, max_files
13900# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13901 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13902# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13903 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13904# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13905
13906# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13907 do iter = 1, xrows
13908# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13909 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13910# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13911 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13912# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13913 end do
13914# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13915 close (unit)
13916# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13917 end do
13918# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13919
13920# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13921 ! Calculate offsets
13922# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13923 domain_xstart = x_coords(1)
13924# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13925 x_step = x_cc(1) - x_cc(0)
13926# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13927 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)
13928# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13929 global_offset_x = nint(abs(delta_x)/x_step)
13930# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13931 case (3) ! 3D case - determine grid structure
13932# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13933 ! Find yRows by counting rows with same x
13934# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13935 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13936# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13937 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13938# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13939
13940# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13941 yrows = 1
13942# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13943 do
13944# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13945 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13946# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13947 if (ios2 /= 0) exit
13948# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13949 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13950# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13951 yrows = yrows + 1
13952# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13953 else
13954# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13955 exit
13956# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13957 end if
13958# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13959 end do
13960# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13961 close (unit2)
13962# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13963
13964# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13965 ! Count total rows
13966# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13967 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13968# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13969 nrows = 0
13970# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13971 do
13972# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13973 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13974# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13975 if (ios2 /= 0) exit
13976# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13977 nrows = nrows + 1
13978# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13979 end do
13980# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13981 close (unit2)
13982# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13983
13984# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13985 xrows = nrows/yrows
13986# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13987#ifdef MFC_DEBUG
13988# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13989 block
13990# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13991 use iso_fortran_env, only: output_unit
13992# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13993
13994# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13995 print *, 'm_icpp_patches.fpp:1079: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13996# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13997
13998# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13999 call flush (output_unit)
14000# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14001 end block
14002# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14003#endif
14004# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14005 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14006# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14007
14008# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14009
14010# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14011
14012# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14013
14014# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14015#if defined(MFC_OpenACC)
14016# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14017!$acc enter data create(x_coords, y_coords, stored_values)
14018# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14019#elif defined(MFC_OpenMP)
14020# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14021!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14022# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14023#endif
14024# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14025 index_x = i
14026# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14027 index_y = j
14028# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14029
14030# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14031 ! Read all files
14032# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14033 do f = 1, max_files
14034# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14035 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14036# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14037 if (ios /= 0) then
14038# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14039 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14040# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14041 cycle
14042# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14043 end if
14044# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14045
14046# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14047 iter = 0
14048# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14049 do iix = 1, xrows
14050# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14051 do iiy = 1, yrows
14052# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14053 iter = iter + 1
14054# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14055 if (f == 1) then
14056# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14057 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14058# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14059 else
14060# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14061 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14062# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14063 end if
14064# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14065 if (ios /= 0) call s_mpi_abort("Error reading data")
14066# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14067 end do
14068# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14069 end do
14070# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14071 close (unit)
14072# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14073 end do
14074# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075
14076# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077 ! Calculate offsets
14078# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 x_step = x_cc(1) - x_cc(0)
14080# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081 y_step = y_cc(1) - y_cc(0)
14082# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14084# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14086# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087 global_offset_x = nint(abs(delta_x)/x_step)
14088# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089 global_offset_y = nint(abs(delta_y)/y_step)
14090# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091 end select
14092# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093
14094# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095 files_loaded = .true.
14096# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097 end if
14098# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099
14100# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101 ! Data assignment
14102# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103 select case (num_dims)
14104# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105 case (1)
14106# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107 idx = i + 1 + global_offset_x
14108# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 do f = 1, sys_size
14110# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14111 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14112# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14113 end do
14114# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14115 case (2)
14116# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14117 idx = i + 1 + global_offset_x - index_x
14118# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14119 do f = 1, sys_size - 1
14120# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14121 jump = merge(1, 0, f >= eqn_idx%mom%end)
14122# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14123 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14124# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14125 end do
14126# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14127 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14128# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14129 case (3)
14130# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14131 idx = i + 1 + global_offset_x - index_x
14132# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14133 idy = j + 1 + global_offset_y - index_y
14134# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14135 do f = 1, sys_size - 1
14136# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14137 jump = merge(1, 0, f >= eqn_idx%mom%end)
14138# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14139 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14140# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14141 end do
14142# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14143 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
14144# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14145 end select
14146# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14147 case (380) ! Taylor-Green vortex
14148# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14149 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
14150# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14151 ! geometry 9
14152# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14153 mach = 0.1
14154# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14155 if (patch_id == 1) then
14156# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14157 q_prim_vf(eqn_idx%E)%sf(i, j, &
14158# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14159 & 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)
14160# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14161 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)
14162# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14163 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)
14164# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14165 end if
14166# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14167 case default
14168# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14169 call s_int_to_str(patch_id, istr)
14170# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14171 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14172# 1079 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14173 end select
14174 end if
14175
14176 ! Updating the patch identities bookkeeping variable
14177 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14178 end if
14179 end if
14180 end do
14181 end do
14182 end do
14183 if (allocated(stored_values)) then
14184# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14185#ifdef MFC_DEBUG
14186# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14187 block
14188# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14189 use iso_fortran_env, only: output_unit
14190# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14191
14192# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14193 print *, 'm_icpp_patches.fpp:1089: ', '@:DEALLOCATE(stored_values)'
14194# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14195
14196# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14197 call flush (output_unit)
14198# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14199 end block
14200# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14201#endif
14202# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14203
14204# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14205#if defined(MFC_OpenACC)
14206# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14207!$acc exit data delete(stored_values)
14208# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14209#elif defined(MFC_OpenMP)
14210# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14211!$omp target exit data map(release:stored_values)
14212# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14213#endif
14214# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14215 deallocate (stored_values)
14216# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14217#ifdef MFC_DEBUG
14218# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14219 block
14220# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14221 use iso_fortran_env, only: output_unit
14222# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14223
14224# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14225 print *, 'm_icpp_patches.fpp:1089: ', '@:DEALLOCATE(x_coords)'
14226# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14227
14228# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14229 call flush (output_unit)
14230# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 end block
14232# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233#endif
14234# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235
14236# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237#if defined(MFC_OpenACC)
14238# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239!$acc exit data delete(x_coords)
14240# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241#elif defined(MFC_OpenMP)
14242# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243!$omp target exit data map(release:x_coords)
14244# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245#endif
14246# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 deallocate (x_coords)
14248# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249 end if
14250# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251
14252# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253 if (allocated(y_coords)) then
14254# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255#ifdef MFC_DEBUG
14256# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257 block
14258# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259 use iso_fortran_env, only: output_unit
14260# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261
14262# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263 print *, 'm_icpp_patches.fpp:1089: ', '@:DEALLOCATE(y_coords)'
14264# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265
14266# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267 call flush (output_unit)
14268# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269 end block
14270# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271#endif
14272# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273
14274# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275#if defined(MFC_OpenACC)
14276# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277!$acc exit data delete(y_coords)
14278# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279#elif defined(MFC_OpenMP)
14280# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281!$omp target exit data map(release:y_coords)
14282# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283#endif
14284# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 deallocate (y_coords)
14286# 1089 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 end if
14288
14289 end subroutine s_icpp_cuboid
14290
14291 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
14292 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
14293 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
14294 !! allow for the smoothing of its lateral boundary.
14295 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
14296
14297 integer, intent(in) :: patch_id
14298
14299#ifdef MFC_MIXED_PRECISION
14300 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14301#else
14302 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
14303#endif
14304 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14305 integer :: i, j, k !< Generic loop iterators
14306 real(wp) :: radius
14307
14308 integer :: xRows, yRows, nRows, iix, iiy, max_files
14309# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14310 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14311# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14312 real(wp) :: x_len, x_step, y_len, y_step
14313# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14314 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14315# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14316 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
14317# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14318 real(wp) :: delta_x, delta_y
14319# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14320 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
14321# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14322 character(len=200) :: errmsg
14323# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14324 real(wp), allocatable :: stored_values(:,:,:)
14325# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14326 real(wp), allocatable :: x_coords(:), y_coords(:)
14327# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14328 logical :: files_loaded = .false.
14329# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14330 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14331# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14332 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
14333# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14334 character(len=20) :: file_num_str !< For storing the file number as a string
14335# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14336 character(len=20) :: zeros_part !< For the trailing zeros part
14337# 1110 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14338 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
14339 ! Place any declaration of intermediate variables here
14340# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14342# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 real(wp) :: eps
14344# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14345
14346# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14347 ! IGR Jets Arrays to stor position and radii of jets from input file
14348# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14349 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14350# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14351 ! Variables to describe initial condition of jet
14352# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14353 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14354# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14355 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
14356# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14357 real(wp), dimension(0:n,0:p) :: rcut_arr
14358# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14359 integer :: l, q, s !< Iterators for reading input files
14360# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14361 integer :: start, end !< Ints to keep track of position in file
14362# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14363 character(len=1000) :: line !< String to store line in file
14364# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14365 character(len=25) :: value !< String to store value in line
14366# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14367 integer :: NJet !< Number of jets
14368# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14369
14370# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14371 eps = 1e-9_wp
14372# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14373
14374# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14375 if (patch_icpp(patch_id)%hcid == 303) then
14376# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14377 eps_smooth = 3._wp
14378# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14379 open (unit=10, file="njet.txt", status="old", action="read")
14380# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14381 read (10, *) njet
14382# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14383 close (10)
14384# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14385
14386# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14387 allocate (y_th_arr(0:njet - 1))
14388# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14389 allocate (z_th_arr(0:njet - 1))
14390# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14391 allocate (r_th_arr(0:njet - 1))
14392# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14393
14394# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14395 open (unit=10, file="jets.csv", status="old", action="read")
14396# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14397 do q = 0, njet - 1
14398# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14399 read (10, '(A)') line ! Read a full line as a string
14400# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14401 start = 1
14402# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14403
14404# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14405 do l = 0, 2
14406# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14407 end = index(line(start:), ',') ! Find the next comma
14408# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14409 if (end == 0) then
14410# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14411 value = trim(adjustl(line(start:))) ! Last value in the line
14412# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14413 else
14414# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14415 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14416# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14417 start = start + end ! Move to next value
14418# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14419 end if
14420# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14421 if (l == 0) then
14422# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14423 read (value, *) y_th_arr(q) ! Convert string to numeric value
14424# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14425 else if (l == 1) then
14426# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14427 read (value, *) z_th_arr(q)
14428# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14429 else
14430# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14431 read (value, *) r_th_arr(q)
14432# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14433 end if
14434# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14435 end do
14436# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14437 end do
14438# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14439 close (10)
14440# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14441
14442# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14443 do q = 0, p
14444# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14445 do l = 0, n
14446# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14447 rcut = 0._wp
14448# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14449 do s = 0, njet - 1
14450# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14451 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14452# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14453 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14454# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14455 end do
14456# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14457 rcut_arr(l, q) = rcut
14458# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14459 end do
14460# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14461 end do
14462# 1111 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14463 end if
14464
14465 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
14466 ! information
14467 x_centroid = patch_icpp(patch_id)%x_centroid
14468 y_centroid = patch_icpp(patch_id)%y_centroid
14469 z_centroid = patch_icpp(patch_id)%z_centroid
14470 length_x = patch_icpp(patch_id)%length_x
14471 length_y = patch_icpp(patch_id)%length_y
14472 length_z = patch_icpp(patch_id)%length_z
14473 radius = patch_icpp(patch_id)%radius
14474 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14475 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14476
14477 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
14478 x_boundary%beg = x_centroid - 0.5_wp*length_x
14479 x_boundary%end = x_centroid + 0.5_wp*length_x
14480 y_boundary%beg = y_centroid - 0.5_wp*length_y
14481 y_boundary%end = y_centroid + 0.5_wp*length_y
14482 z_boundary%beg = z_centroid - 0.5_wp*length_z
14483 z_boundary%end = z_centroid + 0.5_wp*length_z
14484
14485 ! Initialize eta=1; modified if smoothing is enabled
14486 eta = 1._wp
14487
14488 ! Assign patch vars if cell is covered and patch has write permission
14489 do k = 0, p
14490 do j = 0, n
14491 do i = 0, m
14492 if (grid_geometry == 3) then
14493 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
14494 else
14495 cart_y = y_cc(j)
14496 cart_z = z_cc(k)
14497 end if
14498
14499 if (patch_icpp(patch_id)%smoothen) then
14500 if (.not. f_is_default(length_x)) then
14501 eta = tanh(smooth_coeff/min(dy, &
14502 & dz)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14503 & + 0.5_wp
14504 else if (.not. f_is_default(length_y)) then
14505 eta = tanh(smooth_coeff/min(dx, &
14506 & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
14507 & + 0.5_wp
14508 else
14509 eta = tanh(smooth_coeff/min(dx, &
14510 & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
14511 & + 0.5_wp
14512 end if
14513 end if
14514
14515 if (((.not. f_is_default(length_x) .and. (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 &
14516 & .and. x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i)) .or. (.not. f_is_default(length_y) &
14517 & .and. (x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 .and. y_boundary%beg <= cart_y &
14518 & .and. y_boundary%end >= cart_y) .or. (.not. f_is_default(length_z) .and. (x_cc(i) - x_centroid)**2 &
14519 & + (cart_y - y_centroid)**2 <= radius**2 .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) &
14520 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
14521 & k) == smooth_patch_id) then
14522 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
14523
14524
14525 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14526 select case (patch_icpp(patch_id)%hcid)
14527# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14528 case (300) ! Rayleigh-Taylor instability
14529# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14530 rhoh = 3._wp
14531# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14532 rhol = 1._wp
14533# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14534 pref = 1.e5_wp
14535# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14536 pint = pref
14537# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14538 h = 0.7_wp
14539# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14540 lam = 0.2_wp
14541# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14542 wl = 2._wp*pi/lam
14543# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14544 amp = 0.025_wp/wl
14545# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14546
14547# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14548 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
14549# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14550
14551# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14552 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14553# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14554
14555# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14556 if (alph < eps) alph = eps
14557# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14558 if (alph > 1._wp - eps) alph = 1._wp - eps
14559# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14560
14561# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14562 if (y_cc(j) > inth) then
14563# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14564 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14565# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14566 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14567# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14568 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14569# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14570 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14571# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14572 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14573# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14574 else
14575# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14576 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14577# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14578 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14579# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14580 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14581# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14582 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14583# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14584 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14585# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14586 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14587# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14588 end if
14589# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14590 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14591# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14592 h = 0.0_wp
14593# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14594 lam = 1.0_wp
14595# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14596 amp = patch_icpp(patch_id)%a(2)
14597# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14598 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14599# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14600 if (x_cc(i) > inth) then
14601# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14602 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14603# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14604 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14605# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14606 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
14607# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14608 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14609# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14610 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14611# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14612 end if
14613# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14614 case (302) ! 3D Jet with IGR
14615# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14616 ux_th = 10*sqrt(1.4*0.4)
14617# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14618 ux_am = 0.0*sqrt(1.4)
14619# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14620 p_th = 2.0_wp
14621# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14622 p_am = 1.0_wp
14623# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14624 rho_th = 1._wp
14625# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14626 rho_am = 1._wp
14627# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14628 y_th = 0.0_wp
14629# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14630 z_th = 0.0_wp
14631# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14632 r_th = 1._wp
14633# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14634 eps_smooth = 1._wp
14635# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14636 eps = 1e-6
14637# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14638
14639# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14640 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14641# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14642 rcut = f_cut_on(r - r_th, eps_smooth)
14643# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14644 xcut = f_cut_on(x_cc(i), eps_smooth)
14645# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14646
14647# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14648 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14649# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14650 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14651# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14652 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14653# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14654
14655# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14656 if (num_fluids == 1) then
14657# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14658 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14659# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14660 else
14661# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14662 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14663# 1174 "/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*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14665# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14666 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))
14667# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14668 end if
14669# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14670
14671# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14672 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14673# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14674 case (303) ! 3D Multijet
14675# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14676 eps_smooth = 3.0_wp
14677# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14678 ux_th = 10*sqrt(1.4*0.4)
14679# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14680 ux_am = 2.5*sqrt(1.4*0.4)
14681# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14682 p_th = 0.8_wp
14683# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14684 p_am = 0.4_wp
14685# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14686 rho_th = 1._wp
14687# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14688 rho_am = 1._wp
14689# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14690 eps = 1e-6
14691# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14692
14693# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14694 rcut = rcut_arr(j, k)
14695# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14696 xcut = f_cut_on(x_cc(i), eps_smooth)
14697# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14698
14699# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14700 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14701# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14702 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14703# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14704 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14705# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14706
14707# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14708 if (num_fluids == 1) then
14709# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14710 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14711# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14712 else
14713# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14714 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14715# 1174 "/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*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14717# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14718 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))
14719# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14720 end if
14721# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14722
14723# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14724 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14725# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14726 case (370) ! 3D extrusion of 2D profile from external data
14727# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14728 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14729# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14730 if (.not. files_loaded) then
14731# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14732 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14733# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14734 do f = 1, max_files
14735# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14736 write (file_num_str, '(I0)') f
14737# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14738 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
14739# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14740 end do
14741# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14742
14743# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14744 ! Common file reading setup
14745# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14746 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14747# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14748 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14749# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14750
14751# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14752 select case (num_dims)
14753# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14754 case (1, 2) ! 1D and 2D cases are similar
14755# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14756 ! Count lines
14757# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14758 line_count = 0
14759# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14760 do
14761# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14762 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14763# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14764 if (ios2 /= 0) exit
14765# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14766 line_count = line_count + 1
14767# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14768 end do
14769# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14770 close (unit2)
14771# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14772
14773# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14774 xrows = line_count
14775# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14776 yrows = 1
14777# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14778 index_x = 0
14779# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14780 if (num_dims == 2) index_x = i
14781# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14782#ifdef MFC_DEBUG
14783# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14784 block
14785# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14786 use iso_fortran_env, only: output_unit
14787# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14788
14789# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14790 print *, 'm_icpp_patches.fpp:1174: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14791# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14792
14793# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14794 call flush (output_unit)
14795# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14796 end block
14797# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14798#endif
14799# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14800 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14801# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14802
14803# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14804
14805# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14806
14807# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14808#if defined(MFC_OpenACC)
14809# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14810!$acc enter data create(x_coords, stored_values)
14811# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14812#elif defined(MFC_OpenMP)
14813# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14814!$omp target enter data map(always,alloc:x_coords, stored_values)
14815# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14816#endif
14817# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14818
14819# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14820 ! Read data from all files
14821# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14822 do f = 1, max_files
14823# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14824 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14825# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14826 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14827# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14828
14829# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14830 do iter = 1, xrows
14831# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14832 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14833# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14834 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14835# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14836 end do
14837# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14838 close (unit)
14839# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14840 end do
14841# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14842
14843# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14844 ! Calculate offsets
14845# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14846 domain_xstart = x_coords(1)
14847# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14848 x_step = x_cc(1) - x_cc(0)
14849# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14850 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)
14851# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14852 global_offset_x = nint(abs(delta_x)/x_step)
14853# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14854 case (3) ! 3D case - determine grid structure
14855# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14856 ! Find yRows by counting rows with same x
14857# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14858 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14859# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14860 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14861# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14862
14863# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14864 yrows = 1
14865# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14866 do
14867# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14868 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14869# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14870 if (ios2 /= 0) exit
14871# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14872 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
14873# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14874 yrows = yrows + 1
14875# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14876 else
14877# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14878 exit
14879# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14880 end if
14881# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14882 end do
14883# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14884 close (unit2)
14885# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14886
14887# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14888 ! Count total rows
14889# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14890 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14891# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14892 nrows = 0
14893# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14894 do
14895# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14896 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14897# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14898 if (ios2 /= 0) exit
14899# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14900 nrows = nrows + 1
14901# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14902 end do
14903# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14904 close (unit2)
14905# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14906
14907# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908 xrows = nrows/yrows
14909# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910#ifdef MFC_DEBUG
14911# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912 block
14913# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914 use iso_fortran_env, only: output_unit
14915# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916
14917# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918 print *, 'm_icpp_patches.fpp:1174: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14919# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920
14921# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922 call flush (output_unit)
14923# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924 end block
14925# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926#endif
14927# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14929# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930
14931# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932
14933# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934
14935# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936
14937# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938#if defined(MFC_OpenACC)
14939# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940!$acc enter data create(x_coords, y_coords, stored_values)
14941# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942#elif defined(MFC_OpenMP)
14943# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14945# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946#endif
14947# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948 index_x = i
14949# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950 index_y = j
14951# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952
14953# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 ! Read all files
14955# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956 do f = 1, max_files
14957# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14959# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960 if (ios /= 0) then
14961# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14963# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964 cycle
14965# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966 end if
14967# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968
14969# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970 iter = 0
14971# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972 do iix = 1, xrows
14973# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974 do iiy = 1, yrows
14975# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 iter = iter + 1
14977# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978 if (f == 1) then
14979# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14981# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982 else
14983# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14985# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986 end if
14987# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988 if (ios /= 0) call s_mpi_abort("Error reading data")
14989# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990 end do
14991# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992 end do
14993# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994 close (unit)
14995# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996 end do
14997# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998
14999# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000 ! Calculate offsets
15001# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002 x_step = x_cc(1) - x_cc(0)
15003# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004 y_step = y_cc(1) - y_cc(0)
15005# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15007# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15009# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010 global_offset_x = nint(abs(delta_x)/x_step)
15011# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15012 global_offset_y = nint(abs(delta_y)/y_step)
15013# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15014 end select
15015# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15016
15017# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15018 files_loaded = .true.
15019# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15020 end if
15021# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15022
15023# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15024 ! Data assignment
15025# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15026 select case (num_dims)
15027# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15028 case (1)
15029# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15030 idx = i + 1 + global_offset_x
15031# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15032 do f = 1, sys_size
15033# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15034 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15035# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15036 end do
15037# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15038 case (2)
15039# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15040 idx = i + 1 + global_offset_x - index_x
15041# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15042 do f = 1, sys_size - 1
15043# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15044 jump = merge(1, 0, f >= eqn_idx%mom%end)
15045# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15046 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15047# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15048 end do
15049# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15050 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15051# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15052 case (3)
15053# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15054 idx = i + 1 + global_offset_x - index_x
15055# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15056 idy = j + 1 + global_offset_y - index_y
15057# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15058 do f = 1, sys_size - 1
15059# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15060 jump = merge(1, 0, f >= eqn_idx%mom%end)
15061# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15062 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15063# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15064 end do
15065# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15066 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15067# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15068 end select
15069# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15070 case (380) ! Taylor-Green vortex
15071# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15072 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15073# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15074 ! geometry 9
15075# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15076 mach = 0.1
15077# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15078 if (patch_id == 1) then
15079# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15080 q_prim_vf(eqn_idx%E)%sf(i, j, &
15081# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15082 & 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)
15083# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15084 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)
15085# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15086 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)
15087# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15088 end if
15089# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15090 case default
15091# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15092 call s_int_to_str(patch_id, istr)
15093# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15094 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
15095# 1174 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15096 end select
15097 end if
15098
15099 ! Updating the patch identities bookkeeping variable
15100 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15101 end if
15102 end do
15103 end do
15104 end do
15105 if (allocated(stored_values)) then
15106# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15107#ifdef MFC_DEBUG
15108# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15109 block
15110# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15111 use iso_fortran_env, only: output_unit
15112# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15113
15114# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15115 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(stored_values)'
15116# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15117
15118# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15119 call flush (output_unit)
15120# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15121 end block
15122# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15123#endif
15124# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15125
15126# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15127#if defined(MFC_OpenACC)
15128# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15129!$acc exit data delete(stored_values)
15130# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15131#elif defined(MFC_OpenMP)
15132# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15133!$omp target exit data map(release:stored_values)
15134# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15135#endif
15136# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15137 deallocate (stored_values)
15138# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15139#ifdef MFC_DEBUG
15140# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15141 block
15142# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15143 use iso_fortran_env, only: output_unit
15144# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15145
15146# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15147 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(x_coords)'
15148# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15149
15150# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15151 call flush (output_unit)
15152# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15153 end block
15154# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15155#endif
15156# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15157
15158# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15159#if defined(MFC_OpenACC)
15160# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15161!$acc exit data delete(x_coords)
15162# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15163#elif defined(MFC_OpenMP)
15164# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15165!$omp target exit data map(release:x_coords)
15166# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15167#endif
15168# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15169 deallocate (x_coords)
15170# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15171 end if
15172# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15173
15174# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15175 if (allocated(y_coords)) then
15176# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15177#ifdef MFC_DEBUG
15178# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15179 block
15180# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15181 use iso_fortran_env, only: output_unit
15182# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15183
15184# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15185 print *, 'm_icpp_patches.fpp:1183: ', '@:DEALLOCATE(y_coords)'
15186# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15187
15188# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15189 call flush (output_unit)
15190# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15191 end block
15192# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15193#endif
15194# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15195
15196# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15197#if defined(MFC_OpenACC)
15198# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15199!$acc exit data delete(y_coords)
15200# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15201#elif defined(MFC_OpenMP)
15202# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15203!$omp target exit data map(release:y_coords)
15204# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15205#endif
15206# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15207 deallocate (y_coords)
15208# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15209 end if
15210
15211 end subroutine s_icpp_cylinder
15212
15213 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
15214 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
15215 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
15216 !! the smoothing of its boundary.
15217 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
15218
15219 integer, intent(in) :: patch_id
15220
15221#ifdef MFC_MIXED_PRECISION
15222 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15223#else
15224 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15225#endif
15226 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15227 integer :: i, j, k !< Generic loop iterators
15228 real(wp) :: a, b, c, d
15229
15230 integer :: xRows, yRows, nRows, iix, iiy, max_files
15231# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15232 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
15233# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15234 real(wp) :: x_len, x_step, y_len, y_step
15235# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15236 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15237# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15238 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
15239# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15240 real(wp) :: delta_x, delta_y
15241# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15242 character(len=100), dimension(sys_size) :: fileNames !< Arrays to store all data from files
15243# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15244 character(len=200) :: errmsg
15245# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15246 real(wp), allocatable :: stored_values(:,:,:)
15247# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15248 real(wp), allocatable :: x_coords(:), y_coords(:)
15249# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15250 logical :: files_loaded = .false.
15251# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15252 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
15253# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15254 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" !< For example /home/MFC/examples/1D_Shock/D/
15255# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15256 character(len=20) :: file_num_str !< For storing the file number as a string
15257# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15258 character(len=20) :: zeros_part !< For the trailing zeros part
15259# 1204 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15260 character(len=6), parameter :: zeros_default = "000000" !< Default zeros (can be changed)
15261 ! Place any declaration of intermediate variables here
15262# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15263 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15264# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15265 real(wp) :: eps
15266# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15267
15268# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15269 ! IGR Jets Arrays to stor position and radii of jets from input file
15270# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15271 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15272# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15273 ! Variables to describe initial condition of jet
15274# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15275 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15276# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15277 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
15278# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15279 real(wp), dimension(0:n,0:p) :: rcut_arr
15280# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15281 integer :: l, q, s !< Iterators for reading input files
15282# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15283 integer :: start, end !< Ints to keep track of position in file
15284# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15285 character(len=1000) :: line !< String to store line in file
15286# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15287 character(len=25) :: value !< String to store value in line
15288# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15289 integer :: NJet !< Number of jets
15290# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15291
15292# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15293 eps = 1e-9_wp
15294# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15295
15296# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15297 if (patch_icpp(patch_id)%hcid == 303) then
15298# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15299 eps_smooth = 3._wp
15300# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15301 open (unit=10, file="njet.txt", status="old", action="read")
15302# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15303 read (10, *) njet
15304# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15305 close (10)
15306# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15307
15308# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15309 allocate (y_th_arr(0:njet - 1))
15310# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15311 allocate (z_th_arr(0:njet - 1))
15312# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15313 allocate (r_th_arr(0:njet - 1))
15314# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15315
15316# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15317 open (unit=10, file="jets.csv", status="old", action="read")
15318# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15319 do q = 0, njet - 1
15320# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15321 read (10, '(A)') line ! Read a full line as a string
15322# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15323 start = 1
15324# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15325
15326# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15327 do l = 0, 2
15328# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15329 end = index(line(start:), ',') ! Find the next comma
15330# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15331 if (end == 0) then
15332# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15333 value = trim(adjustl(line(start:))) ! Last value in the line
15334# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15335 else
15336# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15337 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15338# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15339 start = start + end ! Move to next value
15340# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15341 end if
15342# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15343 if (l == 0) then
15344# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15345 read (value, *) y_th_arr(q) ! Convert string to numeric value
15346# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15347 else if (l == 1) then
15348# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15349 read (value, *) z_th_arr(q)
15350# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15351 else
15352# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15353 read (value, *) r_th_arr(q)
15354# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15355 end if
15356# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15357 end do
15358# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15359 end do
15360# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15361 close (10)
15362# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15363
15364# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15365 do q = 0, p
15366# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367 do l = 0, n
15368# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369 rcut = 0._wp
15370# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 do s = 0, njet - 1
15372# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15374# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15376# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 end do
15378# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 rcut_arr(l, q) = rcut
15380# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381 end do
15382# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 end do
15384# 1205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385 end if
15386
15387 ! Transferring the centroid information of the plane to be swept
15388 x_centroid = patch_icpp(patch_id)%x_centroid
15389 y_centroid = patch_icpp(patch_id)%y_centroid
15390 z_centroid = patch_icpp(patch_id)%z_centroid
15391 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15392 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15393
15394 ! Obtaining coefficients of the equation describing the sweep plane
15395 a = patch_icpp(patch_id)%normal(1)
15396 b = patch_icpp(patch_id)%normal(2)
15397 c = patch_icpp(patch_id)%normal(3)
15398 d = -a*x_centroid - b*y_centroid - c*z_centroid
15399
15400 ! Initialize eta=1; modified if smoothing is enabled
15401 eta = 1._wp
15402
15403 ! Assign patch vars if cell is covered and patch has write permission
15404 do k = 0, p
15405 do j = 0, n
15406 do i = 0, m
15407 if (grid_geometry == 3) then
15408 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
15409 else
15410 cart_y = y_cc(j)
15411 cart_z = z_cc(k)
15412 end if
15413
15414 if (patch_icpp(patch_id)%smoothen) then
15415 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, &
15416 & dz)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
15417 end if
15418
15419 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, &
15420 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
15421 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
15422
15423
15424 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15425 select case (patch_icpp(patch_id)%hcid)
15426# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15427 case (300) ! Rayleigh-Taylor instability
15428# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15429 rhoh = 3._wp
15430# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15431 rhol = 1._wp
15432# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15433 pref = 1.e5_wp
15434# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15435 pint = pref
15436# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15437 h = 0.7_wp
15438# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15439 lam = 0.2_wp
15440# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15441 wl = 2._wp*pi/lam
15442# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15443 amp = 0.025_wp/wl
15444# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15445
15446# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15447 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
15448# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15449
15450# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15451 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15452# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15453
15454# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15455 if (alph < eps) alph = eps
15456# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15457 if (alph > 1._wp - eps) alph = 1._wp - eps
15458# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15459
15460# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15461 if (y_cc(j) > inth) then
15462# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15463 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15464# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15465 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15466# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15467 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15468# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15469 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15470# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15471 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15472# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15473 else
15474# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15475 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15476# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15477 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15478# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15479 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15480# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15481 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15482# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15484# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15486# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487 end if
15488# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15490# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491 h = 0.0_wp
15492# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493 lam = 1.0_wp
15494# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495 amp = patch_icpp(patch_id)%a(2)
15496# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15498# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499 if (x_cc(i) > inth) then
15500# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15502# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15504# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
15506# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15508# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15510# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511 end if
15512# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513 case (302) ! 3D Jet with IGR
15514# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515 ux_th = 10*sqrt(1.4*0.4)
15516# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 ux_am = 0.0*sqrt(1.4)
15518# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519 p_th = 2.0_wp
15520# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 p_am = 1.0_wp
15522# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523 rho_th = 1._wp
15524# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 rho_am = 1._wp
15526# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527 y_th = 0.0_wp
15528# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 z_th = 0.0_wp
15530# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 r_th = 1._wp
15532# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 eps_smooth = 1._wp
15534# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 eps = 1e-6
15536# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537
15538# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15540# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541 rcut = f_cut_on(r - r_th, eps_smooth)
15542# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543 xcut = f_cut_on(x_cc(i), eps_smooth)
15544# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545
15546# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15548# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15550# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15552# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553
15554# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555 if (num_fluids == 1) then
15556# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15557 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15558# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15559 else
15560# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15561 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15562# 1245 "/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*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15564# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15565 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))
15566# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15567 end if
15568# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15569
15570# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15571 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15572# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15573 case (303) ! 3D Multijet
15574# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15575 eps_smooth = 3.0_wp
15576# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15577 ux_th = 10*sqrt(1.4*0.4)
15578# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15579 ux_am = 2.5*sqrt(1.4*0.4)
15580# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15581 p_th = 0.8_wp
15582# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15583 p_am = 0.4_wp
15584# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15585 rho_th = 1._wp
15586# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15587 rho_am = 1._wp
15588# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15589 eps = 1e-6
15590# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15591
15592# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 rcut = rcut_arr(j, k)
15594# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15595 xcut = f_cut_on(x_cc(i), eps_smooth)
15596# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15597
15598# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15599 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15600# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15601 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15602# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15603 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15604# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15605
15606# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15607 if (num_fluids == 1) then
15608# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15609 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15610# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15611 else
15612# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15613 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15614# 1245 "/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*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15616# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15617 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))
15618# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15619 end if
15620# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15621
15622# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15623 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15624# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15625 case (370) ! 3D extrusion of 2D profile from external data
15626# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15627 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15628# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15629 if (.not. files_loaded) then
15630# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15631 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15632# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15633 do f = 1, max_files
15634# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15635 write (file_num_str, '(I0)') f
15636# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15637 filenames(f) = trim(init_dir) // "prim." // trim(file_num_str) // ".00." // zeros_default // ".dat"
15638# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15639 end do
15640# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15641
15642# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15643 ! Common file reading setup
15644# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15645 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15646# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15647 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
15648# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15649
15650# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15651 select case (num_dims)
15652# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15653 case (1, 2) ! 1D and 2D cases are similar
15654# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15655 ! Count lines
15656# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15657 line_count = 0
15658# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15659 do
15660# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15661 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15662# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15663 if (ios2 /= 0) exit
15664# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15665 line_count = line_count + 1
15666# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15667 end do
15668# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15669 close (unit2)
15670# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15671
15672# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15673 xrows = line_count
15674# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15675 yrows = 1
15676# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15677 index_x = 0
15678# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15679 if (num_dims == 2) index_x = i
15680# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15681#ifdef MFC_DEBUG
15682# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15683 block
15684# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15685 use iso_fortran_env, only: output_unit
15686# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15687
15688# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15689 print *, 'm_icpp_patches.fpp:1245: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15690# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15691
15692# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15693 call flush (output_unit)
15694# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15695 end block
15696# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15697#endif
15698# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15699 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15700# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15701
15702# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15703
15704# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15705
15706# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15707#if defined(MFC_OpenACC)
15708# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15709!$acc enter data create(x_coords, stored_values)
15710# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15711#elif defined(MFC_OpenMP)
15712# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15713!$omp target enter data map(always,alloc:x_coords, stored_values)
15714# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15715#endif
15716# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15717
15718# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15719 ! Read data from all files
15720# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15721 do f = 1, max_files
15722# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15723 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15724# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15725 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15726# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15727
15728# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15729 do iter = 1, xrows
15730# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15731 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15732# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15733 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
15734# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15735 end do
15736# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15737 close (unit)
15738# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15739 end do
15740# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15741
15742# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15743 ! Calculate offsets
15744# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15745 domain_xstart = x_coords(1)
15746# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15747 x_step = x_cc(1) - x_cc(0)
15748# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15749 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)
15750# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15751 global_offset_x = nint(abs(delta_x)/x_step)
15752# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15753 case (3) ! 3D case - determine grid structure
15754# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15755 ! Find yRows by counting rows with same x
15756# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15757 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15758# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15759 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15760# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15761
15762# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15763 yrows = 1
15764# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15765 do
15766# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15767 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15768# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15769 if (ios2 /= 0) exit
15770# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15771 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
15772# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15773 yrows = yrows + 1
15774# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15775 else
15776# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15777 exit
15778# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15779 end if
15780# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15781 end do
15782# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15783 close (unit2)
15784# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15785
15786# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15787 ! Count total rows
15788# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15789 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15790# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15791 nrows = 0
15792# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15793 do
15794# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15795 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15796# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15797 if (ios2 /= 0) exit
15798# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15799 nrows = nrows + 1
15800# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15801 end do
15802# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15803 close (unit2)
15804# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15805
15806# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15807 xrows = nrows/yrows
15808# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15809#ifdef MFC_DEBUG
15810# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15811 block
15812# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15813 use iso_fortran_env, only: output_unit
15814# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15815
15816# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15817 print *, 'm_icpp_patches.fpp:1245: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
15818# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15819
15820# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15821 call flush (output_unit)
15822# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15823 end block
15824# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15825#endif
15826# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15827 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
15828# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15829
15830# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15831
15832# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15833
15834# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15835
15836# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15837#if defined(MFC_OpenACC)
15838# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15839!$acc enter data create(x_coords, y_coords, stored_values)
15840# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15841#elif defined(MFC_OpenMP)
15842# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15843!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
15844# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15845#endif
15846# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15847 index_x = i
15848# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15849 index_y = j
15850# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15851
15852# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15853 ! Read all files
15854# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15855 do f = 1, max_files
15856# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15857 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15858# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15859 if (ios /= 0) then
15860# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15861 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15862# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15863 cycle
15864# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15865 end if
15866# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15867
15868# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15869 iter = 0
15870# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15871 do iix = 1, xrows
15872# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15873 do iiy = 1, yrows
15874# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15875 iter = iter + 1
15876# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15877 if (f == 1) then
15878# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15879 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15880# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15881 else
15882# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15883 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15884# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15885 end if
15886# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15887 if (ios /= 0) call s_mpi_abort("Error reading data")
15888# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15889 end do
15890# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15891 end do
15892# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15893 close (unit)
15894# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15895 end do
15896# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15897
15898# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15899 ! Calculate offsets
15900# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15901 x_step = x_cc(1) - x_cc(0)
15902# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15903 y_step = y_cc(1) - y_cc(0)
15904# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15905 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15906# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15907 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15908# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15909 global_offset_x = nint(abs(delta_x)/x_step)
15910# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15911 global_offset_y = nint(abs(delta_y)/y_step)
15912# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15913 end select
15914# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15915
15916# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15917 files_loaded = .true.
15918# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15919 end if
15920# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15921
15922# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15923 ! Data assignment
15924# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15925 select case (num_dims)
15926# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15927 case (1)
15928# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15929 idx = i + 1 + global_offset_x
15930# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15931 do f = 1, sys_size
15932# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15933 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15934# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15935 end do
15936# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15937 case (2)
15938# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15939 idx = i + 1 + global_offset_x - index_x
15940# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15941 do f = 1, sys_size - 1
15942# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15943 jump = merge(1, 0, f >= eqn_idx%mom%end)
15944# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15945 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15946# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15947 end do
15948# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15949 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15950# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15951 case (3)
15952# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15953 idx = i + 1 + global_offset_x - index_x
15954# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15955 idy = j + 1 + global_offset_y - index_y
15956# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15957 do f = 1, sys_size - 1
15958# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15959 jump = merge(1, 0, f >= eqn_idx%mom%end)
15960# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15961 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15962# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15963 end do
15964# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15965 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15966# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15967 end select
15968# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15969 case (380) ! Taylor-Green vortex
15970# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15971 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15972# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15973 ! geometry 9
15974# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15975 mach = 0.1
15976# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15977 if (patch_id == 1) then
15978# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15979 q_prim_vf(eqn_idx%E)%sf(i, j, &
15980# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15981 & 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)
15982# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15983 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)
15984# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15985 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)
15986# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15987 end if
15988# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15989 case default
15990# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15991 call s_int_to_str(patch_id, istr)
15992# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15993 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
15994# 1245 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15995 end select
15996 end if
15997
15998 ! Updating the patch identities bookkeeping variable
15999 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
16000 end if
16001 end do
16002 end do
16003 end do
16004 if (allocated(stored_values)) then
16005# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16006#ifdef MFC_DEBUG
16007# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16008 block
16009# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16010 use iso_fortran_env, only: output_unit
16011# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16012
16013# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16014 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(stored_values)'
16015# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16016
16017# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16018 call flush (output_unit)
16019# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16020 end block
16021# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16022#endif
16023# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16024
16025# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16026#if defined(MFC_OpenACC)
16027# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16028!$acc exit data delete(stored_values)
16029# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16030#elif defined(MFC_OpenMP)
16031# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16032!$omp target exit data map(release:stored_values)
16033# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16034#endif
16035# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16036 deallocate (stored_values)
16037# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16038#ifdef MFC_DEBUG
16039# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16040 block
16041# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16042 use iso_fortran_env, only: output_unit
16043# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16044
16045# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16046 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(x_coords)'
16047# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16048
16049# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16050 call flush (output_unit)
16051# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16052 end block
16053# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16054#endif
16055# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16056
16057# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16058#if defined(MFC_OpenACC)
16059# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16060!$acc exit data delete(x_coords)
16061# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16062#elif defined(MFC_OpenMP)
16063# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16064!$omp target exit data map(release:x_coords)
16065# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16066#endif
16067# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16068 deallocate (x_coords)
16069# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16070 end if
16071# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16072
16073# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16074 if (allocated(y_coords)) then
16075# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16076#ifdef MFC_DEBUG
16077# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16078 block
16079# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16080 use iso_fortran_env, only: output_unit
16081# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16082
16083# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16084 print *, 'm_icpp_patches.fpp:1254: ', '@:DEALLOCATE(y_coords)'
16085# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16086
16087# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16088 call flush (output_unit)
16089# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16090 end block
16091# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16092#endif
16093# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16094
16095# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16096#if defined(MFC_OpenACC)
16097# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16098!$acc exit data delete(y_coords)
16099# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16100#elif defined(MFC_OpenMP)
16101# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16102!$omp target exit data map(release:y_coords)
16103# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16104#endif
16105# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16106 deallocate (y_coords)
16107# 1254 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16108 end if
16109
16110 end subroutine s_icpp_sweep_plane
16111
16112 !> The STL patch is a 2/3D geometry that is imported from an STL file.
16113 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
16114
16115 integer, intent(in) :: patch_id
16116
16117#ifdef MFC_MIXED_PRECISION
16118 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16119#else
16120 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16121#endif
16122 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16123
16124 ! Variables for IBM+STL
16125 real(wp) :: normals(1:3) !< Boundary normal buffer
16126 integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex
16127 real(wp), allocatable, dimension(:,:,:) :: boundary_v !< Boundary vertex buffer
16128 integer :: i, j, k !< Generic loop iterators
16129 type(t_bbox) :: bbox, bbox_old
16130 type(t_model) :: model
16131 type(ic_model_parameters) :: params
16132 real(wp), dimension(1:3) :: point, model_center
16133 real(wp) :: grid_mm(1:3,1:2)
16134 integer :: cell_num
16135 integer :: ncells
16136 real(wp), dimension(1:4,1:4) :: transform, transform_n
16137
16138 if (proc_rank == 0) then
16139 print *, " * Reading model: " // trim(patch_icpp(patch_id)%model_filepath)
16140 end if
16141
16142 model = f_model_read(patch_icpp(patch_id)%model_filepath)
16143 params%scale(:) = patch_icpp(patch_id)%model_scale(:)
16144 params%translate(:) = patch_icpp(patch_id)%model_translate(:)
16145 params%rotate(:) = patch_icpp(patch_id)%model_rotate(:)
16146 params%spc = patch_icpp(patch_id)%model_spc
16147 params%threshold = patch_icpp(patch_id)%model_threshold
16148
16149 if (proc_rank == 0) then
16150 print *, " * Transforming model."
16151 end if
16152
16153 ! Get the model center before transforming the model
16154 bbox_old = f_create_bbox(model)
16155 model_center(1:3) = (bbox_old%min(1:3) + bbox_old%max(1:3))/2._wp
16156
16157 ! Compute the transform matrices for vertices and normals
16158 transform = f_create_transform_matrix(params, model_center)
16159 transform_n = f_create_transform_matrix(params)
16160
16161 call s_transform_model(model, transform, transform_n)
16162
16163 ! Recreate the bounding box after transformation
16164 bbox = f_create_bbox(model)
16165
16166 ! Show the number of vertices in the original STL model
16167 if (proc_rank == 0) then
16168 print *, ' * Number of input model vertices:', 3*model%ntrs
16169 end if
16170
16171 call s_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count)
16172
16173 ! Show the number of edges and boundary edges in 2D STL models
16174 if (proc_rank == 0 .and. p == 0) then
16175 print *, ' * Number of 2D model boundary edges:', boundary_edge_count
16176 end if
16177
16178 if (proc_rank == 0) then
16179 write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3)
16180 write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp
16181 write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3)
16182
16183 grid_mm(1,:) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/)
16184 grid_mm(2,:) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/)
16185
16186 if (p > 0) then
16187 grid_mm(3,:) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/)
16188 else
16189 grid_mm(3,:) = (/0._wp, 0._wp/)
16190 end if
16191
16192 write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:,1)
16193 write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:,1) + grid_mm(:,2))/2._wp
16194 write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:,2)
16195 end if
16196
16197 ncells = (m + 1)*(n + 1)*(p + 1)
16198 do i = 0, m; do j = 0, n; do k = 0, p
16199 cell_num = i*(n + 1)*(p + 1) + j*(p + 1) + (k + 1)
16200 if (proc_rank == 0 .and. mod(cell_num, ncells/100) == 0) then
16201 write (*, "(A, I3, A)", advance="no") char(13) // " * Generating grid: ", nint(100*real(cell_num)/ncells), "%"
16202 end if
16203
16204 point = (/x_cc(i), y_cc(j), 0._wp/)
16205 if (p > 0) then
16206 point(3) = z_cc(k)
16207 end if
16208
16209 if (grid_geometry == 3) then
16210 point = f_convert_cyl_to_cart(point)
16211 end if
16212
16213 eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc)
16214
16215 if (eta > patch_icpp(patch_id)%model_threshold) then
16216 eta = 1._wp
16217 else if (.not. patch_icpp(patch_id)%smoothen) then
16218 eta = 0._wp
16219 end if
16220
16221 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
16222
16223 ! Note: Should probably use *eta* to compute primitive variables if defining them analytically.
16224
16225 end do; end do; end do
16226
16227 if (proc_rank == 0) then
16228 print *, ""
16229 print *, " * Cleaning up."
16230 end if
16231
16232 call s_model_free(model)
16233
16234 end subroutine s_icpp_model
16235
16236 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
16237 subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
16238
16239
16240# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16241#if MFC_OpenACC
16242# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16243!$acc routine seq
16244# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16245#elif MFC_OpenMP
16246# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16247
16248# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16249
16250# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16251!$omp declare target device_type(any)
16252# 1385 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16253#endif
16254
16255 real(wp), intent(in) :: cyl_y, cyl_z
16256
16257 cart_y = cyl_y*sin(cyl_z)
16258 cart_z = cyl_y*cos(cyl_z)
16259
16260 end subroutine s_convert_cylindrical_to_cartesian_coord
16261
16262 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
16263 function f_convert_cyl_to_cart(cyl) result(cart)
16264
16265
16266# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16267#if MFC_OpenACC
16268# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16269!$acc routine seq
16270# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16271#elif MFC_OpenMP
16272# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16273
16274# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16275
16276# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16277!$omp declare target device_type(any)
16278# 1397 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16279#endif
16280
16281 real(wp), dimension(1:3), intent(in) :: cyl
16282 real(wp), dimension(1:3) :: cart
16283
16284 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
16285
16286 end function f_convert_cyl_to_cart
16287
16288 !> Archimedes spiral function
16289 elemental function f_r(myth, offset, a)
16290
16291
16292# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16293#if MFC_OpenACC
16294# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16295!$acc routine seq
16296# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16297#elif MFC_OpenMP
16298# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16299
16300# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16301
16302# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16303!$omp declare target device_type(any)
16304# 1409 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16305#endif
16306 real(wp), intent(in) :: myth, offset, a
16307 real(wp) :: b
16308 real(wp) :: f_r
16309
16310 ! r(th) = a + b*th
16311
16312 b = 2._wp*a/(2._wp*pi)
16313 f_r = a + b*myth + offset
16314
16315 end function f_r
16316
16317end module m_icpp_patches
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_assign_variables
Assigns initial primitive variables to computational cells based on patch geometry.
Definition m_assign_variables.fpp.f90:328
m_assign_variables::s_assign_patch_primitive_variables
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Pointer to mixture or species patch assignment routine.
Definition m_assign_variables.fpp.f90:343
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::small_radius
real(wp), parameter small_radius
Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:19
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:23
m_constants::max_2d_fourier_modes
integer, parameter max_2d_fourier_modes
Max Fourier mode index for 2D modal patch (geometry 13).
Definition m_constants.fpp.f90:30
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:31
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor Number of cells in the x-, y- and z-coordinate directions.
Definition m_global_parameters.fpp.f90:42
m_global_parameters::sys_size
integer sys_size
Number of unknowns in the system of equations.
Definition m_global_parameters.fpp.f90:76
m_global_parameters::num_patches
integer num_patches
Number of patches composing initial condition.
Definition m_global_parameters.fpp.f90:141
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:51
m_global_parameters::x_cc
real(wp), dimension(:), allocatable x_cc
Locations of cell-centers (cc) in x-, y- and z-directions, respectively.
Definition m_global_parameters.fpp.f90:56
m_global_parameters::patch_icpp
type(ic_patch_parameters), dimension(num_patches_max) patch_icpp
IC patch parameters (max: num_patches_max).
Definition m_global_parameters.fpp.f90:142
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:45
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:44
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:43
m_global_parameters::eqn_idx
type(eqn_idx_info) eqn_idx
All conserved-variable equation index ranges and scalars.
Definition m_global_parameters.fpp.f90:96
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:333
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:328
m_icpp_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_icpp_patches.fpp.f90:387
m_icpp_patches::s_icpp_ellipse
subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid an...
Definition m_icpp_patches.fpp.f90:6002
m_icpp_patches::cart_y
real(wp) cart_y
Definition m_icpp_patches.fpp.f90:409
m_icpp_patches::y_centroid
real(wp) y_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::length_x
real(wp) length_x
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::x_centroid
real(wp) x_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::f_convert_cyl_to_cart
real(wp) function, dimension(1:3) f_convert_cyl_to_cart(cyl)
Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
Definition m_icpp_patches.fpp.f90:16264
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:2507
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:10407
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:13398
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:3807
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:12382
m_icpp_patches::cart_z
real(wp) cart_z
Definition m_icpp_patches.fpp.f90:409
m_icpp_patches::length_z
real(wp) length_z
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::istr
character(len=5) istr
string to store int to string result for error checking
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::s_icpp_sweep_plane
subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:15218
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:8206
m_icpp_patches::s_apply_icpp_patches
impure subroutine, public s_apply_icpp_patches(patch_id_fp, q_prim_vf)
Dispatch each initial condition patch to its geometry-specific initialization routine.
Definition m_icpp_patches.fpp.f90:417
m_icpp_patches::smooth_coeff
real(wp) smooth_coeff
Smoothing coefficient (mirrors ic_patch_parameterssmooth_coeff).
Definition m_icpp_patches.fpp.f90:407
m_icpp_patches::s_icpp_line_segment
subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem....
Definition m_icpp_patches.fpp.f90:532
m_icpp_patches::y_boundary
type(bounds_info) y_boundary
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::s_icpp_sphere
subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet...
Definition m_icpp_patches.fpp.f90:12501
m_icpp_patches::eta
real(wp) eta
Pseudo volume fraction for patch boundary smoothing.
Definition m_icpp_patches.fpp.f90:408
m_icpp_patches::s_icpp_1d_bubble_pulse
subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
Definition m_icpp_patches.fpp.f90:11721
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:12437
m_icpp_patches::length_y
real(wp) length_y
Definition m_icpp_patches.fpp.f90:405
m_icpp_patches::s_icpp_model
subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
The STL patch is a 2/3D geometry that is imported from an STL file.
Definition m_icpp_patches.fpp.f90:16114
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:16238
m_icpp_patches::f_r
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
Definition m_icpp_patches.fpp.f90:16290
m_icpp_patches::z_centroid
real(wp) z_centroid
Definition m_icpp_patches.fpp.f90:404
m_icpp_patches::x_boundary
type(bounds_info) x_boundary
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::smooth_patch_id
integer smooth_patch_id
Definition m_icpp_patches.fpp.f90:406
m_icpp_patches::z_boundary
type(bounds_info) z_boundary
Patch boundary locations in x, y, z.
Definition m_icpp_patches.fpp.f90:410
m_icpp_patches::s_icpp_sweep_line
subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:9522
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:7305
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:14296
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:1196
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:5110
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:318
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:328
m_mpi_common::s_mpi_abort
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
Definition m_mpi_common.fpp.f90:859
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::gammas
real(wp), dimension(:), allocatable, public gammas
Definition m_variables_conversion.fpp.f90:361
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:361
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:361
m_derived_types::bounds_info
Derived type adding beginning (beg) and end bounds info as attributes.
Definition m_derived_types.fpp.f90:477
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331