MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_icpp_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_icpp_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp" 1
18!> Allocate memory and read initial condition data for IC extrusion.
19!>
20!> @details
21!> This macro handles the complete initialization process for IC extrusion by:
22!>
23!> **Memory Allocation:**
24!> - stored_values(xRows, yRows, sys_size) - stores primitive variable data from files
25!> - x_coords(nrows) - stores x-coordinates from input files
26!> - y_coords(nrows) - stores y-coordinates from input files (3D case only)
27!>
28!> **File Reading Operations:**
29!> - Reads primitive variable data from multiple files with pattern:
30!> `prim.<file_number>.00.<file_extension>.dat`
31!> - Files are read from directory specified by `files_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 timestep field is controlled by the `file_extension` parameter
52!> @note Directory path is set via the `files_dir` parameter
53!> @warning Aborts execution if file reading errors occur.
54
55# 67 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
56
57# 214 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 233 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
60# 7 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
61# 1 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp" 1
62# 5 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
63
64# 72 "/home/runner/work/MFC/MFC/src/common/include/1dHardcodedIC.fpp"
65# 8 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
66# 1 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp" 1
67# 38 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 572 "/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# 133 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 279 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
75# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
76# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
77# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
78# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
79# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96
97# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98
99# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
100
101# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
102
103# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
104! New line at end of file is required for FYPP
105# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
106# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
107# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
108# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
110# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
112# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113
114# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
116# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
117
118# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
119
120# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121
122# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123
124# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
125
126# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127
128# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
129
130# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
131
132# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
133! New line at end of file is required for FYPP
134# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
135
136# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183
184# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
185
186# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
187# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
188
189# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
190
191# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
192
193# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
194
195# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
196
197# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
198
199# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
200
201# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
202
203# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
204
205# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
206
207# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
208
209# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
210
211# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
212! New line at end of file is required for FYPP
213# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
214# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
215# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
216# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
217# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
218# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
219# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
220# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
221
222# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
223# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
224# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
225
226# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
227
228# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
229
230# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
231
232# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
233
234# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
235
236# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
237
238# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
239
240# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
241! New line at end of file is required for FYPP
242# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
243
244# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273
274# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
275
276# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
277
278# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
279
280# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
281
282# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
283
284# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
285
286# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
287
288# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
289
290# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
291
292# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
293
294# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
295
296# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
297
298# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
299! New line at end of file is required for FYPP
300# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
301
302! GPU parallel region (scalar reductions, maxval/minval)
303# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
304
305! GPU parallel loop over threads (most common GPU macro)
306# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308! Required closing for GPU_PARALLEL_LOOP
309# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
310
311! Mark routine for device compilation
312# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314! Declare device-resident data
315# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
316
317! Inner loop within a GPU parallel region
318# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320! Scoped GPU data region
321# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
322
323! Host code with device pointers (for MPI with GPU buffers)
324# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326! Allocate device memory (unscoped)
327# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
328
329! Free device memory
330# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332! Atomic operation on device
333# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334
335! End atomic capture block
336# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
337
338! Copy data between host and device
339# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
340
341! Synchronization barrier
342# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
343
344! Import GPU library module (openacc or omp_lib)
345# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
346
347! Emit code only for AMD compiler
348# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
349
350! Emit code for non-Cray compilers
351# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
352
353! Emit code only for Cray compiler
354# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
355
356! Emit code for non-NVIDIA compilers
357# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
358
359# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
360# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
361! New line at end of file is required for FYPP
362# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
363
364# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
365
366! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
367! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
368! example see misc/nvidia_uvm/bind.sh.
369# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
370
371! Allocate and create GPU device memory
372# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
373
374! Free GPU device memory and deallocate
375# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
376
377! Cray-specific GPU pointer setup for vector fields
378# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
379
380! Cray-specific GPU pointer setup for scalar fields
381# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
382
383! Cray-specific GPU pointer setup for acoustic source spatials
384# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
385
386# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
387
388# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
389! New line at end of file is required for FYPP
390# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
391
392!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
394
396 use m_model ! Subroutine(s) related to STL files
397 use m_derived_types ! Definitions of the derived types
401 use m_helper
402 use m_mpi_common
404 use m_mpi_common
406
407 implicit none
408
409 private; public :: s_apply_icpp_patches
410
414 real(wp) :: smooth_coeff !< Smoothing coefficient (mirrors ic_patch_parameters%smooth_coeff)
415 real(wp) :: eta !< Pseudo volume fraction for patch boundary smoothing
416 real(wp) :: cart_y, cart_z
417 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
418 character(len=5) :: istr !< string to store int to string result for error checking
419
420contains
421
422 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
423 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
424
425 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
426
427#ifdef MFC_MIXED_PRECISION
428 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
429#else
430 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
431#endif
432 integer :: i
433 ! Load STL/OBJ models once into the shared flat arrays if any patch is an STL/OBJ model (geometry 21)
434
435 do i = 1, num_patches
436 if (patch_icpp(i)%geometry == 21) then
438 exit
439 end if
440 end do
441 ! 3D Patch Geometries
442
443 if (p > 0) then
444 do i = 1, num_patches
445 if (proc_rank == 0) then
446 print *, 'Processing patch', i
447 end if
448
449 !> ICPP Patches
450 !> @{
451 ! Spherical patch
452 if (patch_icpp(i)%geometry == 8) then
453 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
454 ! Cuboidal patch
455 else if (patch_icpp(i)%geometry == 9) then
456 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
457 ! Cylindrical patch
458 else if (patch_icpp(i)%geometry == 10) then
459 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
460 ! Swept plane patch
461 else if (patch_icpp(i)%geometry == 11) then
462 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
463 ! Ellipsoidal patch
464 else if (patch_icpp(i)%geometry == 12) then
465 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
466 ! 3D spherical harmonic patch
467 else if (patch_icpp(i)%geometry == 14) then
468 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
469 ! 3D Modified circular patch
470 else if (patch_icpp(i)%geometry == 19) then
471 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
472 ! 3D STL patch
473 else if (patch_icpp(i)%geometry == 21) then
474 call s_icpp_model(i, patch_id_fp, q_prim_vf)
475 end if
476 end do
477 !> @}
478
479 ! 2D Patch Geometries
480 else if (n > 0) then
481 do i = 1, num_patches
482 if (proc_rank == 0) then
483 print *, 'Processing patch', i
484 end if
485
486 !> ICPP Patches
487 !> @{
488 ! Circular patch
489 if (patch_icpp(i)%geometry == 2) then
490 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
491 ! Rectangular patch
492 else if (patch_icpp(i)%geometry == 3) then
493 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
494 ! Swept line patch
495 else if (patch_icpp(i)%geometry == 4) then
496 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
497 ! Elliptical patch
498 else if (patch_icpp(i)%geometry == 5) then
499 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
500 ! Unimplemented patch (formerly isentropic vortex)
501 else if (patch_icpp(i)%geometry == 6) then
502 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
503 & // 'which no longer exists. See Examples. Exiting.')
504 ! 2D modal (Fourier) patch
505 else if (patch_icpp(i)%geometry == 13) then
506 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
507 ! Spiral patch
508 else if (patch_icpp(i)%geometry == 17) then
509 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
510 ! Modified circular patch
511 else if (patch_icpp(i)%geometry == 18) then
512 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
513 ! TaylorGreen vortex patch
514 else if (patch_icpp(i)%geometry == 20) then
515 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
516 ! STL patch
517 else if (patch_icpp(i)%geometry == 21) then
518 call s_icpp_model(i, patch_id_fp, q_prim_vf)
519 end if
520 !> @}
521 end do
522
523 ! 1D Patch Geometries
524 else
525 do i = 1, num_patches
526 if (proc_rank == 0) then
527 print *, 'Processing patch', i
528 end if
529
530 ! Line segment patch
531 if (patch_icpp(i)%geometry == 1) then
532 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
533 ! 1d analytical
534 else if (patch_icpp(i)%geometry == 16) then
535 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
536 end if
537 end do
538 end if
539
540 end subroutine s_apply_icpp_patches
541
542 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
543 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
544 !! patch DOES NOT allow for the smearing of its boundaries.
545 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
546
547 integer, intent(in) :: patch_id
548
549#ifdef MFC_MIXED_PRECISION
550 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
551#else
552 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
553#endif
554 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
555
556 ! Generic loop iterators
557 integer :: i, j, k
558
559 ! Placeholders for the cell boundary values
560
561 integer :: xRows, yRows, nRows, iix, iiy, max_files
562# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
563 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
564# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
565 real(wp) :: x_step, y_step
566# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
567 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
568# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
569 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
570# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
571 real(wp) :: delta_x, delta_y
572# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
573 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
574# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
575 real(wp), allocatable :: stored_values(:,:,:)
576# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
577 real(wp), allocatable :: x_coords(:), y_coords(:)
578# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
579 logical :: files_loaded = .false.
580# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
581 real(wp) :: domain_xstart
582# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
583 character(len=20) :: file_num_str !< For storing the file number as a string
584# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
585 integer :: ios
586# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
587 integer :: ios2
588# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
589
590# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
591 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
592# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
593 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
594# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
595 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
596# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
597 ! y_coords/files_loaded above.
598# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
599 real(wp), allocatable, dimension(:,:,:) :: stored_values274
600# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
601 logical :: files_loaded274 = .false.
602# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
603 integer :: f274, ix274, iy274, unit274, ios274
604# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
605 integer :: local_ix_beg274, local_iy_beg274
606# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
607 character(len=300) :: fname274
608# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
609 character(len=20) :: file_num_str274
610# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
611 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
612# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
613 real(wp) :: file_dx274, file_dy274, r_align274
614 ! Place any declaration of intermediate variables here
615# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
616 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
617
618 j = 0
619 k = 0
620
621 ! Transferring the line segment's centroid and length information
622 x_centroid = patch_icpp(patch_id)%x_centroid
623 length_x = patch_icpp(patch_id)%length_x
624
625 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
626 x_boundary%beg = x_centroid - 0.5_wp*length_x
627 x_boundary%end = x_centroid + 0.5_wp*length_x
628
629 ! Set eta=1 (no smoothing for this patch type)
630 eta = 1._wp
631
632 ! Assign patch vars if cell is covered and patch has write permission
633 do i = 0, m
634 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, &
635 & 0, 0))) then
636 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
637
638
639
640 ! check if this should load a hardcoded patch
641 if (patch_icpp(patch_id)%hcid /= dflt_int) then
642 select case (patch_icpp(patch_id)%hcid)
643# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
644 case (150) ! 1D Smooth Alfven Case for MHD
645# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
646 ! velocity
647# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
648 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
649# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
650 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
651# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
652
653# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
654 ! magnetic field
655# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
656 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
657# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
658 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
659# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
660 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
661# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
662 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
663# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
664 ! SDtoolbox)
665# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
666 if (.not. files_loaded) then
667# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
668 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
669# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
670 do f = 1, max_files
671# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
672 write (file_num_str, '(I0)') f
673# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
674 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
675# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
676 end do
677# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
678
679# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
680 ! Common file reading setup
681# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
682 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
683# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
684 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
685# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
686
687# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
688 select case (num_dims)
689# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
690 case (1, 2) ! 1D and 2D cases are similar
691# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
692 ! Count lines
693# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
694 line_count = 0
695# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
696 do
697# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
698 read (unit2, *, iostat=ios2) dummy_x, dummy_y
699# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
700 if (ios2 /= 0) exit
701# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
702 line_count = line_count + 1
703# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
704 end do
705# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
706 close (unit2)
707# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
708
709# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
710 xrows = line_count
711# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
712 yrows = 1
713# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
714 index_x = 0
715# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
716 if (num_dims == 2) index_x = i
717# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
718#ifdef MFC_DEBUG
719# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
720 block
721# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
722 use iso_fortran_env, only: output_unit
723# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
724
725# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
726 print *, 'm_icpp_patches.fpp:208: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
727# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
728
729# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
730 call flush (output_unit)
731# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
732 end block
733# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
734#endif
735# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
736 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
737# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
738
739# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
740
741# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
742
743# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
744#if defined(MFC_OpenACC)
745# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
746!$acc enter data create(x_coords, stored_values)
747# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
748#elif defined(MFC_OpenMP)
749# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
750!$omp target enter data map(always,alloc:x_coords, stored_values)
751# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
752#endif
753# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
754
755# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
756 ! Read data from all files
757# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
758 do f = 1, max_files
759# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
760 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
761# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
762 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
763# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
764
765# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
766 do iter = 1, xrows
767# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
768 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
769# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
770 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
771# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
772 end do
773# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
774 close (unit)
775# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
776 end do
777# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
778
779# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
780 ! Calculate offsets
781# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
782 domain_xstart = x_coords(1)
783# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
784 x_step = x_cc(1) - x_cc(0)
785# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
786 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
787# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
788 global_offset_x = nint(abs(delta_x)/x_step)
789# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
790 case (3) ! 3D case - determine grid structure
791# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
792 ! Find yRows by counting rows with same x
793# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
794 read (unit2, *, iostat=ios2) x0, y0, dummy_z
795# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
796 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
797# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
798
799# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
800 yrows = 1
801# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
802 do
803# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
804 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
805# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
806 if (ios2 /= 0) exit
807# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
808 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
809# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
810 yrows = yrows + 1
811# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
812 else
813# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
814 exit
815# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
816 end if
817# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
818 end do
819# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
820 close (unit2)
821# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
822
823# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
824 ! Count total rows
825# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
826 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
827# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
828 nrows = 0
829# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
830 do
831# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
832 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
833# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
834 if (ios2 /= 0) exit
835# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
836 nrows = nrows + 1
837# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
838 end do
839# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
840 close (unit2)
841# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
842
843# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
844 xrows = nrows/yrows
845# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
846#ifdef MFC_DEBUG
847# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
848 block
849# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
850 use iso_fortran_env, only: output_unit
851# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
852
853# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
854 print *, 'm_icpp_patches.fpp:208: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
855# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
856
857# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
858 call flush (output_unit)
859# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
860 end block
861# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
862#endif
863# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
864 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
865# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
866
867# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
868
869# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
870
871# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
872
873# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
874#if defined(MFC_OpenACC)
875# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
876!$acc enter data create(x_coords, y_coords, stored_values)
877# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
878#elif defined(MFC_OpenMP)
879# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
880!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
881# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
882#endif
883# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
884 index_x = i
885# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
886 index_y = j
887# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
888
889# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
890 ! Read all files
891# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
892 do f = 1, max_files
893# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
894 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
895# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
896 if (ios /= 0) then
897# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
898 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
899# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
900 cycle
901# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
902 end if
903# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
904
905# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
906 iter = 0
907# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
908 do iix = 1, xrows
909# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
910 do iiy = 1, yrows
911# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
912 iter = iter + 1
913# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
914 if (f == 1) then
915# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
916 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
917# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
918 else
919# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
920 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
921# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
922 end if
923# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
924 if (ios /= 0) call s_mpi_abort("Error reading data")
925# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
926 end do
927# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
928 end do
929# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
930 close (unit)
931# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
932 end do
933# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
934
935# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
936 ! Calculate offsets
937# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
938 x_step = x_cc(1) - x_cc(0)
939# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
940 y_step = y_cc(1) - y_cc(0)
941# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
942 delta_x = x_cc(index_x) - x_coords(1)
943# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
944 delta_y = y_cc(index_y) - y_coords(1)
945# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
946 global_offset_x = nint(abs(delta_x)/x_step)
947# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
948 global_offset_y = nint(abs(delta_y)/y_step)
949# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
950 end select
951# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
952
953# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
954 files_loaded = .true.
955# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
956 end if
957# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
958
959# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
960 ! Data assignment
961# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
962 select case (num_dims)
963# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
964 case (1)
965# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
966 idx = i + 1 + global_offset_x
967# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
968 ! idx must land inside the file's row range: this rank's subdomain offset
969# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
970 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
971# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
972 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
973# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
974 if (idx < 1 .or. idx > xrows) &
975# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
976 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
977# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
978 do f = 1, sys_size
979# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
980 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
981# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
982 end do
983# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
984 case (2)
985# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
986 idx = i + 1 + global_offset_x - index_x
987# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
988 if (idx < 1 .or. idx > xrows) &
989# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
990 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
991# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
992 do f = 1, sys_size - 1
993# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
994 jump = merge(1, 0, f >= eqn_idx%mom%end)
995# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
996 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
997# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
998 end do
999# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1000 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
1001# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1002 case (3)
1003# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1004 idx = i + 1 + global_offset_x - index_x
1005# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1006 idy = j + 1 + global_offset_y - index_y
1007# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1008 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
1009# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1010 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
1011# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1012 do f = 1, sys_size - 1
1013# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1014 jump = merge(1, 0, f >= eqn_idx%mom%end)
1015# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1016 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
1017# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1018 end do
1019# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1020 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
1021# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1022 end select
1023# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1024 case (180) ! Shu-Osher problem
1025# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1026 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
1027# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1028 ! 0.2*sin(5*x)"
1029# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1030 if (patch_id == 2) then
1031# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1032 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
1033# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1034 end if
1035# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1036 case (181) ! Titarev-Torro problem
1037# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1038 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
1039# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1040 ! "1 + 0.1*sin(20*x*pi)"
1041# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1042 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1043# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1044 case (182) ! Multi-component diffusion
1045# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1046 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1047# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1048 x_mid_diffu = 0.05_wp/2.0_wp
1049# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1050 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1051# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1052 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1053# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1054 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1055# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1056 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1057# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1058 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
1059# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1060
1061# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1062 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1063# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1064 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1065# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1066 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1067# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1068 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1069# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1070
1071# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1072 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
1073# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1074 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
1075# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1076 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
1077# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1078 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
1079# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1080
1081# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1082 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1083# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1084
1085# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1086 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1087# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1088
1089# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1090 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)
1091# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1092 case(191) ! 1D Dual Isothermal case
1093# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1094 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
1095# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1096 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1097# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1098 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
1099# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1100
1101# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1102 if (x_cc(i) <= 0.025_wp) then
1103# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1104 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
1105# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1106 else
1107# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1108 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
1109# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1110 end if
1111# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1112
1113# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1114 molar_mass_inv = 1.0_wp/2.01588_wp
1115# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1116 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1117# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1118 case default
1119# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1120 call s_int_to_str(patch_id, istr)
1121# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1122 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1123# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1124 end select
1125 end if
1126
1127 ! Updating the patch identities bookkeeping variable
1128 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1129 end if
1130 end do
1131 if (allocated(stored_values)) then
1132# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1133#ifdef MFC_DEBUG
1134# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1135 block
1136# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1137 use iso_fortran_env, only: output_unit
1138# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1139
1140# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1141 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(stored_values)'
1142# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1143
1144# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1145 call flush (output_unit)
1146# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1147 end block
1148# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1149#endif
1150# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1151
1152# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1153#if defined(MFC_OpenACC)
1154# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1155!$acc exit data delete(stored_values)
1156# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1157#elif defined(MFC_OpenMP)
1158# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1159!$omp target exit data map(release:stored_values)
1160# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1161#endif
1162# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1163 deallocate (stored_values)
1164# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1165#ifdef MFC_DEBUG
1166# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1167 block
1168# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1169 use iso_fortran_env, only: output_unit
1170# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1171
1172# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1173 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(x_coords)'
1174# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1175
1176# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1177 call flush (output_unit)
1178# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1179 end block
1180# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1181#endif
1182# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1183
1184# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1185#if defined(MFC_OpenACC)
1186# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1187!$acc exit data delete(x_coords)
1188# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1189#elif defined(MFC_OpenMP)
1190# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1191!$omp target exit data map(release:x_coords)
1192# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1193#endif
1194# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1195 deallocate (x_coords)
1196# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1197 end if
1198# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1199
1200# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1201 if (allocated(y_coords)) then
1202# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1203#ifdef MFC_DEBUG
1204# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1205 block
1206# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1207 use iso_fortran_env, only: output_unit
1208# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1209
1210# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1211 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(y_coords)'
1212# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1213
1214# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1215 call flush (output_unit)
1216# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1217 end block
1218# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1219#endif
1220# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1221
1222# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1223#if defined(MFC_OpenACC)
1224# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1225!$acc exit data delete(y_coords)
1226# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1227#elif defined(MFC_OpenMP)
1228# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1229!$omp target exit data map(release:y_coords)
1230# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1231#endif
1232# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1233 deallocate (y_coords)
1234# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1235 end if
1236# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237
1238# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 files_loaded = .false.
1240# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1241
1242# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1243 if (allocated(stored_values274)) then
1244# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1245#ifdef MFC_DEBUG
1246# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1247 block
1248# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1249 use iso_fortran_env, only: output_unit
1250# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1251
1252# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1253 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(stored_values274)'
1254# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1255
1256# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1257 call flush (output_unit)
1258# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1259 end block
1260# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1261#endif
1262# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1263
1264# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1265#if defined(MFC_OpenACC)
1266# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1267!$acc exit data delete(stored_values274)
1268# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1269#elif defined(MFC_OpenMP)
1270# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1271!$omp target exit data map(release:stored_values274)
1272# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1273#endif
1274# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1275 deallocate (stored_values274)
1276# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1277 end if
1278# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1279
1280# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1281 files_loaded274 = .false.
1282
1283 end subroutine s_icpp_line_segment
1284
1285 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1286 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1287 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1288
1289 integer, intent(in) :: patch_id
1290
1291#ifdef MFC_MIXED_PRECISION
1292 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1293#else
1294 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1295#endif
1296 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1297 integer :: i, j, k !< Generic loop iterators
1298 real(wp) :: th, thickness, nturns, mya
1299 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1300
1301 integer :: xrows, yrows, nrows, iix, iiy, max_files
1302# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1303 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
1304# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1305 real(wp) :: x_step, y_step
1306# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1307 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1308# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1309 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1310# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1311 real(wp) :: delta_x, delta_y
1312# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1313 character(len=300), dimension(sys_size) :: filenames !< Arrays to store all data from files
1314# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1315 real(wp), allocatable :: stored_values(:,:,:)
1316# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1317 real(wp), allocatable :: x_coords(:), y_coords(:)
1318# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1319 logical :: files_loaded = .false.
1320# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1321 real(wp) :: domain_xstart
1322# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1323 character(len=20) :: file_num_str !< For storing the file number as a string
1324# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1325 integer :: ios
1326# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1327 integer :: ios2
1328# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1329
1330# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1331 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
1332# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1333 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
1334# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1335 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
1336# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1337 ! y_coords/files_loaded above.
1338# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1339 real(wp), allocatable, dimension(:,:,:) :: stored_values274
1340# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1341 logical :: files_loaded274 = .false.
1342# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1343 integer :: f274, ix274, iy274, unit274, ios274
1344# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1345 integer :: local_ix_beg274, local_iy_beg274
1346# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1347 character(len=300) :: fname274
1348# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1349 character(len=20) :: file_num_str274
1350# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1351 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
1352# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1353 real(wp) :: file_dx274, file_dy274, r_align274
1354 ! Place any declaration of intermediate variables here
1355# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1356 real(wp) :: eps, eps_mhd, c_mhd
1357# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1358 real(wp) :: r, rmax, gam, umax, p0
1359# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1360 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1361# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1362 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
1363# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1364 real(wp) :: r0, alpha, r2
1365# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1366 real(wp) :: sina, cosa
1367# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1368 real(wp) :: r_sq
1369# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1370
1371# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1372 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
1373# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1374 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, t_facq, wq
1375# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1376 real(wp) :: rho_avg, rhou_avg, rhov_avg, e_avg
1377# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1378 real(wp) :: rhoq, pq, uq, vq, eq, vortex_eps
1379# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1380 integer :: igq, jgq
1381# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1382
1383# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1384 ! # 291 - Shear/Thermal Layer Case
1385# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1386 real(wp) :: delta_shear, u_max, u_mean
1387# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1388 real(wp) :: t_wall, t_inf, p_atm, t_loc
1389# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1390 real(wp) :: delta_th, r_mix
1391# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1392 real(wp) :: y_n2, y_o2, mw_n2, mw_o2
1393# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1394 real(wp) :: bottom_blend_u, bottom_blend_t
1395# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1396
1397# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1398 ! # 207
1399# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1400 real(wp) :: sigma, gauss1, gauss2
1401# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1402
1403# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1404 ! # 208
1405# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1406 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1407# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1408 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
1409# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1410 integer :: v, idx_lo, idx_hi, idx_mid
1411# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1412 real(wp), parameter :: ly_param = 0.00775735_wp
1413# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1414 real(wp), parameter :: a_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
1415# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1416 integer, parameter :: nwaves = 6
1417# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1418 real(wp), parameter :: y0_ref = 0.0_wp
1419# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1420
1421# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1422 eps = 1.e-9_wp
1423
1424 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1425 x_centroid = patch_icpp(patch_id)%x_centroid
1426 y_centroid = patch_icpp(patch_id)%y_centroid
1427 mya = patch_icpp(patch_id)%radius
1428 thickness = patch_icpp(patch_id)%length_x
1429 nturns = patch_icpp(patch_id)%length_y
1430
1431 !
1432 logic_grid = 0
1433 do k = 0, int(m*91*nturns)
1434 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1435
1436 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1437 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1438
1439 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1440 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1441
1442 do j = 0, n; do i = 0, m
1443 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) &
1444 & < spiral_y_max)) then
1445 logic_grid(i, j, 0) = 1
1446 end if
1447 end do; end do
1448 end do
1449
1450 do j = 0, n
1451 do i = 0, m
1452 if ((logic_grid(i, j, 0) == 1)) then
1453 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1454
1455
1456 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1457 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1458# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 case (200) ! Two-fluid cubic interface
1460# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1462# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
1464# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
1466# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
1468# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
1470# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
1472# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 end if
1474# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1476# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1478# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479 rmax = 0.2_wp
1480# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481
1482# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1484# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1486# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1488# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489
1490# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 if (r < rmax) then
1492# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1494# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1496# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1498# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1499 else if (r < 2*rmax) then
1500# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1501 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1502# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1503 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1504# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1505 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)))
1506# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1507 else
1508# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1509 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1510# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1511 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1512# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1513 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1514# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1515 end if
1516# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1517 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1518# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1519 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1520# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1521 rmax = 0.2_wp
1522# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1523
1524# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1525 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1526# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1527 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1528# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1529 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1530# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531
1532# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1533 if (r < rmax) then
1534# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1535 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1536# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1537 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1538# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1539 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1540# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1541 else if (r < 2*rmax) then
1542# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1543 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1544# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1545 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1546# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1547 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)))
1548# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1549 else
1550# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1551 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1552# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1553 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1554# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1555 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1556# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1557 end if
1558# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1559
1560# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1561 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
1562# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1563 case (204) ! Rayleigh-Taylor instability
1564# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1565 rhoh = 3._wp
1566# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1567 rhol = 1._wp
1568# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1569 pref = 1.e5_wp
1570# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1571 pint = pref
1572# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1573 h = 0.7_wp
1574# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1575 lam = 0.2_wp
1576# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1577 wl = 2._wp*pi/lam
1578# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1579 amp = 0.05_wp/wl
1580# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1581
1582# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1583 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1584# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1585
1586# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1587 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1588# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1589
1590# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1591 if (alph < eps) alph = eps
1592# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1593 if (alph > 1._wp - eps) alph = 1._wp - eps
1594# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1595
1596# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1597 if (y_cc(j) > inth) then
1598# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1599 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1600# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1601 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1602# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1603 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1604# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1605 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1606# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1607 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1608# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1609 else
1610# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1611 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1612# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1613 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1614# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1615 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1616# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1617 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1618# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1619 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1620# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1621 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1622# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1623 end if
1624# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1625 case (205) ! 2D lung wave interaction problem
1626# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1627 h = 0.0_wp ! non dim origin y
1628# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1629 lam = 1.0_wp ! non dim lambda
1630# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1631 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1632# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1633
1634# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1635 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1636# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1637
1638# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1639 if (y_cc(j) > inth) then
1640# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1641 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1642# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1643 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1644# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1645 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1646# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1647 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1648# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1649 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1650# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1651 end if
1652# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1653 case (206) ! 2D lung wave interaction problem - horizontal domain
1654# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1655 h = 0.0_wp ! non dim origin y
1656# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1657 lam = 1.0_wp ! non dim lambda
1658# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1659 amp = patch_icpp(patch_id)%a(2)
1660# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1661
1662# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1663 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1664# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1665
1666# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1667 if (x_cc(i) > intl) then ! this is the liquid
1668# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1669 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1670# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1671 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1672# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1673 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1674# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1675 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1676# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1677 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1678# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1679 end if
1680# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1681 case (207) ! Kelvin Helmholtz Instability
1682# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1683 sigma = 0.05_wp/sqrt(2.0_wp)
1684# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1685 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1686# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1687 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1688# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1689 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)
1690# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1691 case (208) ! Richtmeyer Meshkov Instability
1692# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1693 lam = 1.0_wp
1694# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1695 eps = 1.0e-6_wp
1696# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1697 ei = 5.0_wp
1698# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1699 ! Smoothening function to smooth out sharp discontinuity in the interface
1700# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1701 if (x_cc(i) <= 0.7_wp*lam) then
1702# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1703 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1704# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1705 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
1706# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1707 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1708# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1709 alpha_sf6 = 1.0_wp - alpha_air
1710# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1711 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
1712# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1713 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
1714# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1715 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
1716# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1717 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
1718# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1719 end if
1720# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1721 case (250) ! MHD Orszag-Tang vortex
1722# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1723 ! 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),
1724# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1725 ! sin(4*pi*x)/sqrt(4*pi), 0)
1726# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1727
1728# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1729 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1730# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1731 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1732# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1733
1734# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1735 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1736# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1737 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1738# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1739 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1740# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1741 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1742# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1743 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
1744# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1745 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
1746# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1747 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1748# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1749 ! Linear interpolation between r=0.08 and r=1.0
1750# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1751 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1752# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1753 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1754# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1755 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1756# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1757 else
1758# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1759 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
1760# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1761 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
1762# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1763 end if
1764# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1765
1766# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1767 ! case 252 is for the 2D MHD Rotor problem
1768# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1769 case (252) ! 2D MHD Rotor Problem
1770# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1771 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1772# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1773 !
1774# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1775 ! 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
1776# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1777 ! velocity w=20, giving v_tan=2 at r=0.1
1778# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1779
1780# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1781 ! Calculate distance squared from the center
1782# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1783 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1784# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1785
1786# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1787 ! inner radius of 0.1
1788# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1789 if (r_sq <= 0.1**2) then
1790# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1791 ! -- Inside the rotor -- Set density uniformly to 10
1792# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1793 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
1794# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1795
1796# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1797 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1798# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1799 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1800# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1801 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1802# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1803
1804# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1805 ! taper width of 0.015
1806# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1807 else if (r_sq <= 0.115**2) then
1808# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1809 ! linearly smooth the function between r = 0.1 and 0.115
1810# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1811 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1812# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1813
1814# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1815 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)
1816# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1817 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)
1818# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1819 end if
1820# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1821 case (253) ! MHD Smooth Magnetic Vortex
1822# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1823 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1824# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1825 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1826# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1827
1828# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1829 ! velocity
1830# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1831 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))
1832# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1833 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))
1834# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1835
1836# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1837 ! magnetic field
1838# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1839 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)
1840# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1841 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)
1842# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1843
1844# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1845 ! pressure
1846# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1847 q_prim_vf(eqn_idx%E)%sf(i, j, &
1848# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1849 & 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)
1850# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1851 case (260) ! Gaussian Divergence Pulse
1852# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1853 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1854# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1855 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1856# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1857 ! initialized to zero everywhere.
1858# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1859
1860# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1861 eps_mhd = patch_icpp(patch_id)%a(2)
1862# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1863 sigma = patch_icpp(patch_id)%a(3)
1864# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1865 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1866# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1867
1868# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1869 ! B-field
1870# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1871 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1872# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1873 case (261) ! Blob
1874# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1875 r0 = 1._wp/sqrt(8._wp)
1876# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1877 r2 = x_cc(i)**2 + y_cc(j)**2
1878# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1879 r = sqrt(r2)
1880# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1881 alpha = r/r0
1882# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1883 if (alpha < 1) then
1884# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1885 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)
1886# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1887 ! 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)
1888# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1889 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1890# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1891 ! 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
1892# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1893 end if
1894# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1895 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
1896# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1897 ! rotate by \alpha = atan(2)
1898# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1899 alpha = atan(2._wp)
1900# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1901 cosa = cos(alpha)
1902# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1903 sina = sin(alpha)
1904# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1905 ! projection along shock normal
1906# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1907 r = x_cc(i)*cosa + y_cc(j)*sina
1908# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1909
1910# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1911 if (r <= 0.5_wp) then
1912# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1913 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1914# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1915 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1916# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1917 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
1918# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1919 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
1920# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1921 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
1922# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1923 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
1924# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1925 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
1926# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1927 else
1928# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1929 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1930# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1931 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1932# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1933 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
1934# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1935 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
1936# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1937 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
1938# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1939 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
1940# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1941 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
1942# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1943 end if
1944# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1945 ! v^z and B^z remain zero by default
1946# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1947 case (270) ! 2D extrusion of 1D profile from external data
1948# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1949 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1950# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1951 if (.not. files_loaded) then
1952# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1953 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1954# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1955 do f = 1, max_files
1956# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1957 write (file_num_str, '(I0)') f
1958# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1959 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
1960# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1961 end do
1962# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1963
1964# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1965 ! Common file reading setup
1966# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1967 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1968# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1969 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
1970# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1971
1972# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1973 select case (num_dims)
1974# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1975 case (1, 2) ! 1D and 2D cases are similar
1976# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1977 ! Count lines
1978# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1979 line_count = 0
1980# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1981 do
1982# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1983 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1984# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1985 if (ios2 /= 0) exit
1986# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1987 line_count = line_count + 1
1988# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1989 end do
1990# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1991 close (unit2)
1992# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1993
1994# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1995 xrows = line_count
1996# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1997 yrows = 1
1998# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1999 index_x = 0
2000# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2001 if (num_dims == 2) index_x = i
2002# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2003#ifdef MFC_DEBUG
2004# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2005 block
2006# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2007 use iso_fortran_env, only: output_unit
2008# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2009
2010# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2011 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2012# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2013
2014# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2015 call flush (output_unit)
2016# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2017 end block
2018# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2019#endif
2020# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2021 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2022# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2023
2024# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2025
2026# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2027
2028# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2029#if defined(MFC_OpenACC)
2030# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2031!$acc enter data create(x_coords, stored_values)
2032# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2033#elif defined(MFC_OpenMP)
2034# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2035!$omp target enter data map(always,alloc:x_coords, stored_values)
2036# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2037#endif
2038# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2039
2040# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2041 ! Read data from all files
2042# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2043 do f = 1, max_files
2044# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2045 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2046# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2047 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2048# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2049
2050# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2051 do iter = 1, xrows
2052# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2053 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
2054# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2055 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
2056# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2057 end do
2058# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2059 close (unit)
2060# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2061 end do
2062# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2063
2064# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2065 ! Calculate offsets
2066# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2067 domain_xstart = x_coords(1)
2068# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2069 x_step = x_cc(1) - x_cc(0)
2070# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2071 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
2072# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2073 global_offset_x = nint(abs(delta_x)/x_step)
2074# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2075 case (3) ! 3D case - determine grid structure
2076# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2077 ! Find yRows by counting rows with same x
2078# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2079 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2080# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2081 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2082# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2083
2084# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2085 yrows = 1
2086# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2087 do
2088# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2089 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2090# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2091 if (ios2 /= 0) exit
2092# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2093 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
2094# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2095 yrows = yrows + 1
2096# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2097 else
2098# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2099 exit
2100# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2101 end if
2102# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2103 end do
2104# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2105 close (unit2)
2106# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2107
2108# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2109 ! Count total rows
2110# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2111 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2112# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2113 nrows = 0
2114# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2115 do
2116# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2117 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2118# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2119 if (ios2 /= 0) exit
2120# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2121 nrows = nrows + 1
2122# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2123 end do
2124# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2125 close (unit2)
2126# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2127
2128# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2129 xrows = nrows/yrows
2130# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2131#ifdef MFC_DEBUG
2132# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2133 block
2134# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2135 use iso_fortran_env, only: output_unit
2136# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2137
2138# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2139 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2140# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2141
2142# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2143 call flush (output_unit)
2144# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2145 end block
2146# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2147#endif
2148# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2149 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2150# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2151
2152# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2153
2154# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2155
2156# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2157
2158# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2159#if defined(MFC_OpenACC)
2160# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2161!$acc enter data create(x_coords, y_coords, stored_values)
2162# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2163#elif defined(MFC_OpenMP)
2164# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2165!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2166# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2167#endif
2168# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2169 index_x = i
2170# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2171 index_y = j
2172# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2173
2174# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2175 ! Read all files
2176# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2177 do f = 1, max_files
2178# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2179 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2180# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2181 if (ios /= 0) then
2182# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2183 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2184# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2185 cycle
2186# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2187 end if
2188# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2189
2190# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2191 iter = 0
2192# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2193 do iix = 1, xrows
2194# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2195 do iiy = 1, yrows
2196# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2197 iter = iter + 1
2198# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2199 if (f == 1) then
2200# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2201 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2202# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2203 else
2204# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2205 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2206# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2207 end if
2208# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2209 if (ios /= 0) call s_mpi_abort("Error reading data")
2210# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2211 end do
2212# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2213 end do
2214# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2215 close (unit)
2216# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2217 end do
2218# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2219
2220# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2221 ! Calculate offsets
2222# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2223 x_step = x_cc(1) - x_cc(0)
2224# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2225 y_step = y_cc(1) - y_cc(0)
2226# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2227 delta_x = x_cc(index_x) - x_coords(1)
2228# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2229 delta_y = y_cc(index_y) - y_coords(1)
2230# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2231 global_offset_x = nint(abs(delta_x)/x_step)
2232# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2233 global_offset_y = nint(abs(delta_y)/y_step)
2234# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2235 end select
2236# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2237
2238# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2239 files_loaded = .true.
2240# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2241 end if
2242# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2243
2244# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2245 ! Data assignment
2246# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2247 select case (num_dims)
2248# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2249 case (1)
2250# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2251 idx = i + 1 + global_offset_x
2252# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2253 ! idx must land inside the file's row range: this rank's subdomain offset
2254# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2255 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
2256# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2257 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
2258# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2259 if (idx < 1 .or. idx > xrows) &
2260# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2261 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2262# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2263 do f = 1, sys_size
2264# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2265 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2266# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2267 end do
2268# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2269 case (2)
2270# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2271 idx = i + 1 + global_offset_x - index_x
2272# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2273 if (idx < 1 .or. idx > xrows) &
2274# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2275 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2276# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2277 do f = 1, sys_size - 1
2278# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2279 jump = merge(1, 0, f >= eqn_idx%mom%end)
2280# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2281 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2282# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2283 end do
2284# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2285 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2286# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2287 case (3)
2288# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2289 idx = i + 1 + global_offset_x - index_x
2290# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2291 idy = j + 1 + global_offset_y - index_y
2292# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2293 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
2294# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2295 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
2296# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2297 do f = 1, sys_size - 1
2298# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2299 jump = merge(1, 0, f >= eqn_idx%mom%end)
2300# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2301 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2302# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2303 end do
2304# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2305 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2306# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2307 end select
2308# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2309 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
2310# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2311 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
2312# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2313 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
2314# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2315 ! cross-stream-position profile (real cross-stream velocity is legitimately
2316# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2317 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
2318# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2319 ! zero out mom%beg's true physical value.
2320# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2321 if (.not. files_loaded) then
2322# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2323 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
2324# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2325 do f = 1, max_files
2326# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2327 write (file_num_str, '(I0)') f
2328# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2329 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
2330# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2331 end do
2332# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2333
2334# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2335 ! Common file reading setup
2336# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2337 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2338# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2339 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
2340# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2341
2342# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2343 select case (num_dims)
2344# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2345 case (1, 2) ! 1D and 2D cases are similar
2346# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2347 ! Count lines
2348# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2349 line_count = 0
2350# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2351 do
2352# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2353 read (unit2, *, iostat=ios2) dummy_x, dummy_y
2354# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2355 if (ios2 /= 0) exit
2356# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2357 line_count = line_count + 1
2358# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2359 end do
2360# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361 close (unit2)
2362# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363
2364# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 xrows = line_count
2366# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367 yrows = 1
2368# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369 index_x = 0
2370# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 if (num_dims == 2) index_x = i
2372# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373#ifdef MFC_DEBUG
2374# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375 block
2376# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377 use iso_fortran_env, only: output_unit
2378# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379
2380# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2382# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383
2384# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385 call flush (output_unit)
2386# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387 end block
2388# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2389#endif
2390# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2391 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2392# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2393
2394# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2395
2396# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2397
2398# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2399#if defined(MFC_OpenACC)
2400# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2401!$acc enter data create(x_coords, stored_values)
2402# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2403#elif defined(MFC_OpenMP)
2404# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2405!$omp target enter data map(always,alloc:x_coords, stored_values)
2406# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2407#endif
2408# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2409
2410# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2411 ! Read data from all files
2412# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2413 do f = 1, max_files
2414# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2415 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2416# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2417 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2418# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2419
2420# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2421 do iter = 1, xrows
2422# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2423 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
2424# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2425 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
2426# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2427 end do
2428# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2429 close (unit)
2430# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2431 end do
2432# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2433
2434# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2435 ! Calculate offsets
2436# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2437 domain_xstart = x_coords(1)
2438# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2439 x_step = x_cc(1) - x_cc(0)
2440# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2441 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
2442# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2443 global_offset_x = nint(abs(delta_x)/x_step)
2444# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2445 case (3) ! 3D case - determine grid structure
2446# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2447 ! Find yRows by counting rows with same x
2448# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2449 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2450# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2451 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2452# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2453
2454# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2455 yrows = 1
2456# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2457 do
2458# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2459 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2460# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2461 if (ios2 /= 0) exit
2462# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2463 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
2464# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2465 yrows = yrows + 1
2466# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2467 else
2468# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2469 exit
2470# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2471 end if
2472# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2473 end do
2474# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2475 close (unit2)
2476# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2477
2478# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2479 ! Count total rows
2480# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2481 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2482# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2483 nrows = 0
2484# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2485 do
2486# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2487 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2488# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2489 if (ios2 /= 0) exit
2490# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2491 nrows = nrows + 1
2492# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2493 end do
2494# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2495 close (unit2)
2496# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2497
2498# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2499 xrows = nrows/yrows
2500# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2501#ifdef MFC_DEBUG
2502# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2503 block
2504# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2505 use iso_fortran_env, only: output_unit
2506# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2507
2508# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2509 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2510# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2511
2512# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2513 call flush (output_unit)
2514# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2515 end block
2516# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2517#endif
2518# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2519 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2520# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2521
2522# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2523
2524# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2525
2526# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2527
2528# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2529#if defined(MFC_OpenACC)
2530# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2531!$acc enter data create(x_coords, y_coords, stored_values)
2532# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2533#elif defined(MFC_OpenMP)
2534# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2535!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2536# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2537#endif
2538# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2539 index_x = i
2540# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2541 index_y = j
2542# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2543
2544# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2545 ! Read all files
2546# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2547 do f = 1, max_files
2548# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2549 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2550# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2551 if (ios /= 0) then
2552# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2553 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2554# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2555 cycle
2556# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2557 end if
2558# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2559
2560# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2561 iter = 0
2562# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2563 do iix = 1, xrows
2564# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2565 do iiy = 1, yrows
2566# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2567 iter = iter + 1
2568# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2569 if (f == 1) then
2570# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2571 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2572# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2573 else
2574# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2575 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2576# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2577 end if
2578# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2579 if (ios /= 0) call s_mpi_abort("Error reading data")
2580# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2581 end do
2582# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2583 end do
2584# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2585 close (unit)
2586# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2587 end do
2588# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2589
2590# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2591 ! Calculate offsets
2592# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2593 x_step = x_cc(1) - x_cc(0)
2594# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2595 y_step = y_cc(1) - y_cc(0)
2596# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2597 delta_x = x_cc(index_x) - x_coords(1)
2598# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2599 delta_y = y_cc(index_y) - y_coords(1)
2600# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2601 global_offset_x = nint(abs(delta_x)/x_step)
2602# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2603 global_offset_y = nint(abs(delta_y)/y_step)
2604# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2605 end select
2606# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2607
2608# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2609 files_loaded = .true.
2610# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2611 end if
2612# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2613
2614# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2615 ! Data assignment
2616# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2617 select case (num_dims)
2618# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2619 case (1)
2620# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2621 idx = i + 1 + global_offset_x
2622# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2623 ! idx must land inside the file's row range: this rank's subdomain offset
2624# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2625 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
2626# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2627 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
2628# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2629 if (idx < 1 .or. idx > xrows) &
2630# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2631 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2632# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2633 do f = 1, sys_size
2634# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2635 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2636# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2637 end do
2638# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2639 case (2)
2640# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2641 idx = i + 1 + global_offset_x - index_x
2642# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2643 if (idx < 1 .or. idx > xrows) &
2644# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2645 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2646# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2647 do f = 1, sys_size - 1
2648# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2649 jump = merge(1, 0, f >= eqn_idx%mom%end)
2650# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2651 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2652# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2653 end do
2654# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2655 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2656# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2657 case (3)
2658# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2659 idx = i + 1 + global_offset_x - index_x
2660# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2661 idy = j + 1 + global_offset_y - index_y
2662# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2663 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
2664# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2665 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
2666# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2667 do f = 1, sys_size - 1
2668# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2669 jump = merge(1, 0, f >= eqn_idx%mom%end)
2670# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2671 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2672# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2673 end do
2674# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2675 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2676# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2677 end select
2678# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2679 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
2680# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2681 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
2682# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2683 case (274) ! Full 2D field from external data (no extrusion)
2684# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2685 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
2686# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2687 ! extrusion direction and no zeroed component -- all sys_size variables are read and
2688# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2689 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
2690# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2691 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
2692# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2693 ! global grid exactly -- by construction, since the IC generator derives both the
2694# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2695 ! grid and the file contents from the same computation.
2696# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2697 !
2698# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2699 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
2700# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2701 ! file's own first coordinate and this rank's uniform grid spacing -- following the
2702# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2703 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
2704# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2705 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
2706# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2707 ! returns before allocating it otherwise), so a serial-IO run (the default for
2708# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2709 ! golden-file tests) would index into an unallocated array.
2710# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2711 !
2712# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2713 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
2714# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2715 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
2716# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2717 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
2718# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2719 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
2720# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2721 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
2722# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2723 ! global cell offset) are pinned from f274==1's very first record, before any other
2724# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2725 ! record is read, so every subsequent record -- across all variables -- can be tested
2726# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2727 ! against this rank's range and dropped if it falls outside it.
2728# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2729 x_step274 = x_cc(1) - x_cc(0)
2730# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2731 y_step274 = y_cc(1) - y_cc(0)
2732# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2733
2734# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2735 if (.not. files_loaded274) then
2736# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2737#ifdef MFC_DEBUG
2738# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2739 block
2740# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2741 use iso_fortran_env, only: output_unit
2742# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2743
2744# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2745 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
2746# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2747
2748# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2749 call flush (output_unit)
2750# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2751 end block
2752# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2753#endif
2754# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2755 allocate (stored_values274(0:m, 0:n, sys_size))
2756# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2757
2758# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2759
2760# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2761#if defined(MFC_OpenACC)
2762# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2763!$acc enter data create(stored_values274)
2764# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2765#elif defined(MFC_OpenMP)
2766# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2767!$omp target enter data map(always,alloc:stored_values274)
2768# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2769#endif
2770# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2771 do f274 = 1, sys_size
2772# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2773 write (file_num_str274, '(I0)') f274
2774# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2775 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
2776# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2777 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
2778# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2779 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
2780# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2781 do ix274 = 0, m_glb
2782# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2783 do iy274 = 0, n_glb
2784# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2785 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
2786# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2787 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
2788# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2789 ! Capture the file's own origin and spacing from its first records so we can
2790# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2791 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
2792# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2793 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
2794# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2795 if (f274 == 1) then
2796# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2797 if (ix274 == 0 .and. iy274 == 0) then
2798# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2799 x0_274 = dummy_x274
2800# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2801 y0_274 = dummy_y274
2802# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2803 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
2804# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2805 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
2806# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2807 end if
2808# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2809 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
2810# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2811 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
2812# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2813 end if
2814# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2815 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
2816# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2817 & .and. iy274 - local_iy_beg274 <= n) then
2818# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2819 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
2820# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2821 end if
2822# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2823 end do
2824# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2825 end do
2826# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2827 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
2828# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2829 ! read means it was generated for a larger grid and would be silently misread.
2830# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2831 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
2832# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2833 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
2834# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2835 close (unit274)
2836# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2837 end do
2838# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2839
2840# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2841 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
2842# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2843 ! Check alignment via the integer cell offset of this rank's first cell from the file
2844# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2845 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
2846# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2847 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
2848# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2849 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
2850# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2851 ! the global origin.) The spacing checks below must also hold.
2852# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2853 r_align274 = (x_cc(0) - x0_274)/x_step274
2854# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2855 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
2856# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2857 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
2858# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2859 if (m_glb >= 1) then
2860# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2861 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
2862# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2863 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
2864# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2865 end if
2866# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2867 if (n_glb >= 1) then
2868# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2869 r_align274 = (y_cc(0) - y0_274)/y_step274
2870# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2871 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
2872# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2873 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
2874# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2875 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
2876# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2877 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
2878# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2879 end if
2880# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2881
2882# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2883 files_loaded274 = .true.
2884# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2885 end if
2886# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2887 ! Alignment is verified above (or this rank would already have aborted), so the local
2888# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2889 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
2890# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2891 do f274 = 1, sys_size
2892# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2893 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
2894# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2895 end do
2896# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2897 case (271) ! Premixed Flame Vortices Interaction
2898# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2899 if (.not. files_loaded) then
2900# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2901 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
2902# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2903 do f = 1, max_files
2904# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2905 write (file_num_str, '(I0)') f
2906# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2907 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
2908# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2909 end do
2910# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2911
2912# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2913 ! Common file reading setup
2914# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2915 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2916# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2917 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
2918# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2919
2920# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2921 select case (num_dims)
2922# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2923 case (1, 2) ! 1D and 2D cases are similar
2924# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2925 ! Count lines
2926# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2927 line_count = 0
2928# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2929 do
2930# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2931 read (unit2, *, iostat=ios2) dummy_x, dummy_y
2932# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2933 if (ios2 /= 0) exit
2934# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2935 line_count = line_count + 1
2936# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2937 end do
2938# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2939 close (unit2)
2940# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2941
2942# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2943 xrows = line_count
2944# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2945 yrows = 1
2946# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2947 index_x = 0
2948# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2949 if (num_dims == 2) index_x = i
2950# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2951#ifdef MFC_DEBUG
2952# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2953 block
2954# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2955 use iso_fortran_env, only: output_unit
2956# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2957
2958# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2959 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2960# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2961
2962# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2963 call flush (output_unit)
2964# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2965 end block
2966# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2967#endif
2968# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2969 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2970# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2971
2972# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2973
2974# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2975
2976# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2977#if defined(MFC_OpenACC)
2978# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2979!$acc enter data create(x_coords, stored_values)
2980# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2981#elif defined(MFC_OpenMP)
2982# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2983!$omp target enter data map(always,alloc:x_coords, stored_values)
2984# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2985#endif
2986# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2987
2988# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2989 ! Read data from all files
2990# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2991 do f = 1, max_files
2992# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2993 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2994# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2995 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2996# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2997
2998# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2999 do iter = 1, xrows
3000# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3001 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3002# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3003 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3004# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3005 end do
3006# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3007 close (unit)
3008# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3009 end do
3010# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3011
3012# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3013 ! Calculate offsets
3014# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3015 domain_xstart = x_coords(1)
3016# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3017 x_step = x_cc(1) - x_cc(0)
3018# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3019 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
3020# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3021 global_offset_x = nint(abs(delta_x)/x_step)
3022# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3023 case (3) ! 3D case - determine grid structure
3024# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3025 ! Find yRows by counting rows with same x
3026# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3027 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3028# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3029 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3030# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3031
3032# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3033 yrows = 1
3034# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3035 do
3036# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3037 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3038# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3039 if (ios2 /= 0) exit
3040# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3041 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3042# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3043 yrows = yrows + 1
3044# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3045 else
3046# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3047 exit
3048# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3049 end if
3050# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3051 end do
3052# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3053 close (unit2)
3054# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3055
3056# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3057 ! Count total rows
3058# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3059 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3060# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3061 nrows = 0
3062# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3063 do
3064# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3065 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3066# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3067 if (ios2 /= 0) exit
3068# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3069 nrows = nrows + 1
3070# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3071 end do
3072# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3073 close (unit2)
3074# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3075
3076# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3077 xrows = nrows/yrows
3078# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3079#ifdef MFC_DEBUG
3080# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3081 block
3082# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3083 use iso_fortran_env, only: output_unit
3084# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3085
3086# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3087 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3088# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3089
3090# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3091 call flush (output_unit)
3092# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3093 end block
3094# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3095#endif
3096# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3097 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3098# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3099
3100# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3101
3102# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3103
3104# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3105
3106# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3107#if defined(MFC_OpenACC)
3108# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3109!$acc enter data create(x_coords, y_coords, stored_values)
3110# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3111#elif defined(MFC_OpenMP)
3112# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3113!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3114# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3115#endif
3116# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3117 index_x = i
3118# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3119 index_y = j
3120# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3121
3122# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3123 ! Read all files
3124# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3125 do f = 1, max_files
3126# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3127 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3128# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3129 if (ios /= 0) then
3130# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3131 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3132# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3133 cycle
3134# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3135 end if
3136# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3137
3138# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3139 iter = 0
3140# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3141 do iix = 1, xrows
3142# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3143 do iiy = 1, yrows
3144# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3145 iter = iter + 1
3146# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3147 if (f == 1) then
3148# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3149 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3150# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3151 else
3152# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3153 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3154# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3155 end if
3156# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3157 if (ios /= 0) call s_mpi_abort("Error reading data")
3158# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3159 end do
3160# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3161 end do
3162# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3163 close (unit)
3164# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3165 end do
3166# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3167
3168# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3169 ! Calculate offsets
3170# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3171 x_step = x_cc(1) - x_cc(0)
3172# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3173 y_step = y_cc(1) - y_cc(0)
3174# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3175 delta_x = x_cc(index_x) - x_coords(1)
3176# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3177 delta_y = y_cc(index_y) - y_coords(1)
3178# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3179 global_offset_x = nint(abs(delta_x)/x_step)
3180# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3181 global_offset_y = nint(abs(delta_y)/y_step)
3182# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3183 end select
3184# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3185
3186# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3187 files_loaded = .true.
3188# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3189 end if
3190# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3191
3192# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3193 ! Data assignment
3194# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3195 select case (num_dims)
3196# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3197 case (1)
3198# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3199 idx = i + 1 + global_offset_x
3200# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3201 ! idx must land inside the file's row range: this rank's subdomain offset
3202# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3203 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
3204# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3205 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
3206# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3207 if (idx < 1 .or. idx > xrows) &
3208# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3209 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3210# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3211 do f = 1, sys_size
3212# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3213 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3214# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3215 end do
3216# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3217 case (2)
3218# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3219 idx = i + 1 + global_offset_x - index_x
3220# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3221 if (idx < 1 .or. idx > xrows) &
3222# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3223 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3224# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3225 do f = 1, sys_size - 1
3226# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3227 jump = merge(1, 0, f >= eqn_idx%mom%end)
3228# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3229 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3230# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3231 end do
3232# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3233 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3234# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3235 case (3)
3236# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3237 idx = i + 1 + global_offset_x - index_x
3238# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3239 idy = j + 1 + global_offset_y - index_y
3240# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3241 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
3242# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3243 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
3244# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3245 do f = 1, sys_size - 1
3246# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3247 jump = merge(1, 0, f >= eqn_idx%mom%end)
3248# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3249 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3250# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3251 end do
3252# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3253 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3254# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3255 end select
3256# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3257 x1c = 0.0027_wp
3258# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3259 y1c = 0.005_wp
3260# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3261 x2c = 0.0027_wp
3262# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3263 y2c = 0.003_wp
3264# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3265 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
3266# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3267 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
3268# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3269 rvortex = 0.0005_wp
3270# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3271 cvortex = 6000.0_wp
3272# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3273
3274# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3275 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
3276# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3277 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
3278# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3279
3280# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3281 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
3282# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3283 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
3284# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3285 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
3286# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3287 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
3288# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3289 case (272) ! Premixed Flame Instability
3290# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3291 if (.not. files_loaded) then
3292# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3293 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3294# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3295 do f = 1, max_files
3296# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3297 write (file_num_str, '(I0)') f
3298# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3299 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
3300# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3301 end do
3302# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3303
3304# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3305 ! Common file reading setup
3306# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3307 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3308# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3309 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3310# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3311
3312# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3313 select case (num_dims)
3314# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3315 case (1, 2) ! 1D and 2D cases are similar
3316# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3317 ! Count lines
3318# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3319 line_count = 0
3320# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3321 do
3322# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3323 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3324# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3325 if (ios2 /= 0) exit
3326# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3327 line_count = line_count + 1
3328# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3329 end do
3330# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3331 close (unit2)
3332# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3333
3334# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3335 xrows = line_count
3336# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3337 yrows = 1
3338# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3339 index_x = 0
3340# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3341 if (num_dims == 2) index_x = i
3342# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3343#ifdef MFC_DEBUG
3344# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3345 block
3346# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3347 use iso_fortran_env, only: output_unit
3348# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3349
3350# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3351 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3352# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3353
3354# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3355 call flush (output_unit)
3356# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3357 end block
3358# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3359#endif
3360# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3361 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3362# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3363
3364# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3365
3366# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3367
3368# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3369#if defined(MFC_OpenACC)
3370# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3371!$acc enter data create(x_coords, stored_values)
3372# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3373#elif defined(MFC_OpenMP)
3374# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3375!$omp target enter data map(always,alloc:x_coords, stored_values)
3376# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3377#endif
3378# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3379
3380# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3381 ! Read data from all files
3382# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3383 do f = 1, max_files
3384# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3385 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3386# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3387 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3388# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3389
3390# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3391 do iter = 1, xrows
3392# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3393 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3394# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3395 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3396# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3397 end do
3398# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3399 close (unit)
3400# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3401 end do
3402# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3403
3404# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3405 ! Calculate offsets
3406# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3407 domain_xstart = x_coords(1)
3408# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3409 x_step = x_cc(1) - x_cc(0)
3410# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3411 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
3412# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3413 global_offset_x = nint(abs(delta_x)/x_step)
3414# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3415 case (3) ! 3D case - determine grid structure
3416# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3417 ! Find yRows by counting rows with same x
3418# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3419 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3420# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3421 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3422# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3423
3424# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3425 yrows = 1
3426# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3427 do
3428# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3429 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3430# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3431 if (ios2 /= 0) exit
3432# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3433 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3434# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3435 yrows = yrows + 1
3436# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3437 else
3438# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3439 exit
3440# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3441 end if
3442# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3443 end do
3444# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3445 close (unit2)
3446# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3447
3448# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3449 ! Count total rows
3450# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3451 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3452# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3453 nrows = 0
3454# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3455 do
3456# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3457 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3458# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3459 if (ios2 /= 0) exit
3460# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3461 nrows = nrows + 1
3462# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3463 end do
3464# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3465 close (unit2)
3466# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3467
3468# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3469 xrows = nrows/yrows
3470# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3471#ifdef MFC_DEBUG
3472# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3473 block
3474# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3475 use iso_fortran_env, only: output_unit
3476# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3477
3478# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3479 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3480# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3481
3482# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3483 call flush (output_unit)
3484# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3485 end block
3486# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3487#endif
3488# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3489 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3490# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3491
3492# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3493
3494# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3495
3496# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3497
3498# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3499#if defined(MFC_OpenACC)
3500# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3501!$acc enter data create(x_coords, y_coords, stored_values)
3502# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3503#elif defined(MFC_OpenMP)
3504# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3505!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3506# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3507#endif
3508# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3509 index_x = i
3510# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3511 index_y = j
3512# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3513
3514# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3515 ! Read all files
3516# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3517 do f = 1, max_files
3518# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3519 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3520# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3521 if (ios /= 0) then
3522# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3523 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3524# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3525 cycle
3526# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3527 end if
3528# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3529
3530# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3531 iter = 0
3532# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3533 do iix = 1, xrows
3534# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3535 do iiy = 1, yrows
3536# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3537 iter = iter + 1
3538# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3539 if (f == 1) then
3540# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3541 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3542# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3543 else
3544# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3545 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3546# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3547 end if
3548# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3549 if (ios /= 0) call s_mpi_abort("Error reading data")
3550# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3551 end do
3552# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3553 end do
3554# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3555 close (unit)
3556# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3557 end do
3558# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3559
3560# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3561 ! Calculate offsets
3562# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3563 x_step = x_cc(1) - x_cc(0)
3564# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3565 y_step = y_cc(1) - y_cc(0)
3566# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3567 delta_x = x_cc(index_x) - x_coords(1)
3568# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3569 delta_y = y_cc(index_y) - y_coords(1)
3570# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3571 global_offset_x = nint(abs(delta_x)/x_step)
3572# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3573 global_offset_y = nint(abs(delta_y)/y_step)
3574# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3575 end select
3576# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3577
3578# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3579 files_loaded = .true.
3580# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3581 end if
3582# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3583
3584# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3585 ! Data assignment
3586# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3587 select case (num_dims)
3588# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3589 case (1)
3590# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3591 idx = i + 1 + global_offset_x
3592# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3593 ! idx must land inside the file's row range: this rank's subdomain offset
3594# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3595 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
3596# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3597 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
3598# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3599 if (idx < 1 .or. idx > xrows) &
3600# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3601 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3602# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3603 do f = 1, sys_size
3604# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3605 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3606# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3607 end do
3608# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3609 case (2)
3610# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3611 idx = i + 1 + global_offset_x - index_x
3612# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3613 if (idx < 1 .or. idx > xrows) &
3614# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3615 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3616# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3617 do f = 1, sys_size - 1
3618# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3619 jump = merge(1, 0, f >= eqn_idx%mom%end)
3620# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3621 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3622# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3623 end do
3624# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3625 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3626# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3627 case (3)
3628# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3629 idx = i + 1 + global_offset_x - index_x
3630# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3631 idy = j + 1 + global_offset_y - index_y
3632# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3633 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
3634# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3635 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
3636# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3637 do f = 1, sys_size - 1
3638# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3639 jump = merge(1, 0, f >= eqn_idx%mom%end)
3640# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3641 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3642# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3643 end do
3644# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3645 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3646# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3647 end select
3648# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3649
3650# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3651 y_center = y0_ref
3652# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3653 y_dist = y_cc(j) - y_center
3654# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3655 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
3656# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3657 front_shift = a_param*sin(wave_phase)
3658# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3659
3660# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3661 x_mapped = x_cc(i) - front_shift
3662# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3663
3664# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3665 if (x_mapped <= x_coords(1)) then
3666# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3667 do v = 1, sys_size - 1
3668# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3669 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
3670# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3671 end do
3672# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3673 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3674# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3675 else if (x_mapped >= x_coords(xrows)) then
3676# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3677 do v = 1, sys_size - 1
3678# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3679 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
3680# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3681 end do
3682# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3683 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3684# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3685 else
3686# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3687 idx_lo = 1; idx_hi = xrows
3688# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3689 do while (idx_hi - idx_lo > 1)
3690# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3691 idx_mid = (idx_lo + idx_hi)/2
3692# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3693 if (x_coords(idx_mid) <= x_mapped) then
3694# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3695 idx_lo = idx_mid
3696# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3697 else
3698# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3699 idx_hi = idx_mid
3700# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3701 end if
3702# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3703 end do
3704# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3705
3706# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3707 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
3708# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3709
3710# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3711 do v = 1, sys_size - 1
3712# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3713 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
3714# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3715 & v) + interp_wt*stored_values(idx_hi, 1, v)
3716# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3717 end do
3718# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3719 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3720# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3721 end if
3722# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
3724# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
3726# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
3728# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
3730# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
3732# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733 & - y_domain%beg))
3734# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735 if (x_cc(i) > d) then
3736# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3738# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
3740# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
3742# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
3744# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745 do v = eqn_idx%species%beg, eqn_idx%species%end
3746# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
3748# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3749 end do
3750# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3751 end if
3752# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3753 case (280) ! Isentropic vortex
3754# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3755 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3756# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3757 ! geometry 2
3758# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3759 if (patch_id == 1) then
3760# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3761 q_prim_vf(eqn_idx%E)%sf(i, j, &
3762# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3763 & 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) &
3764# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3765 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3766# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3767 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3768# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3769 & 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) &
3770# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3771 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3772# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3773 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3774# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3775 & 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) &
3776# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3777 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3778# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3779 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3780# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3781 & 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) &
3782# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3783 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3784# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3785 end if
3786# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787 case (281) ! Acoustic pulse
3788# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3790# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791 ! geometry 2
3792# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793 if (patch_id == 2) then
3794# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795 q_prim_vf(eqn_idx%E)%sf(i, j, &
3796# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797 & 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))
3798# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3800# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801 & 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))
3802# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3803 end if
3804# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3805 case (282) ! Zero-circulation vortex
3806# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3807 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
3808# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3809 ! geometry 2
3810# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3811 if (patch_id == 2) then
3812# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3813 q_prim_vf(eqn_idx%E)%sf(i, j, &
3814# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3815 & 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))
3816# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3817 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3818# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3819 & 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))
3820# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3821 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3822# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3823 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3824# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3825 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3826# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3827 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3828# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3829 end if
3830# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3831 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
3832# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3833 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
3834# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3835 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
3836# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3837 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
3838# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3839 ! patch_icpp(patch_id)%epsilon; defaults to 5.
3840# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3841 if (patch_id == 1) then
3842# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3843 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
3844# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3845 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
3846# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3847 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
3848# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3849 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
3850# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3851 do igq = 1, 3
3852# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3853 do jgq = 1, 3
3854# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
3856# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
3858# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
3860# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3861 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))
3862# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3863 wq = gauss_w(igq)*gauss_w(jgq)
3864# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865 rhoq = t_facq**1.4_wp
3866# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 pq = t_facq**2.4_wp
3868# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3870# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 & - r2q)
3872# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
3874# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875 & - r2q)
3876# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
3878# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879 rho_avg = rho_avg + wq*rhoq
3880# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881 rhou_avg = rhou_avg + wq*(rhoq*uq)
3882# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 rhov_avg = rhov_avg + wq*(rhoq*vq)
3884# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 e_avg = e_avg + wq*eq
3886# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 end do
3888# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 end do
3890# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891 rho_avg = rho_avg*0.25_wp
3892# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893 rhou_avg = rhou_avg*0.25_wp
3894# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895 rhov_avg = rhov_avg*0.25_wp
3896# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897 e_avg = e_avg*0.25_wp
3898# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
3900# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
3902# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
3904# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
3906# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907 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
3908# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909 end if
3910# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3911 case (291) ! Isothermal Flat Plate
3912# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3913 t_inf = 1125.0_wp
3914# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3915 t_wall = 600.0_wp
3916# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3917 p_atm = 101325.0_wp
3918# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3919
3920# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3921 ! Boundary/Shear Layer thicknesses
3922# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3923 delta_th = 0.0003_wp ! Thermal BL thickness
3924# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3925 delta_shear = 8e-3_wp ! Velocity BL thickness
3926# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3927
3928# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3929 u_max = 50.0_wp ! Freestream Velocity (m/s)
3930# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3931
3932# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3933 mw_n2 = 28.0134e-3_wp
3934# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3935 mw_o2 = 31.999e-3_wp
3936# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3937 y_n2 = 0.767_wp
3938# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3939 y_o2 = 0.233_wp
3940# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3941 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
3942# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3943 bottom_blend_u = tanh(y_cc(j)/delta_shear)
3944# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 bottom_blend_t = tanh(y_cc(j)/delta_th)
3946# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 u_mean = u_max*bottom_blend_u
3948# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
3950# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
3952# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
3954# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3956# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
3958# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
3960# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
3962# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963 case default
3964# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 if (proc_rank == 0) then
3966# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967 call s_int_to_str(patch_id, istr)
3968# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
3970# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 end if
3972# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973 end select
3974 end if
3975
3976 ! Updating the patch identities bookkeeping variable
3977 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
3978 end if
3979 end do
3980 end do
3981 if (allocated(stored_values)) then
3982# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983#ifdef MFC_DEBUG
3984# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 block
3986# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 use iso_fortran_env, only: output_unit
3988# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989
3990# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(stored_values)'
3992# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993
3994# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 call flush (output_unit)
3996# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 end block
3998# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999#endif
4000# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001
4002# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003#if defined(MFC_OpenACC)
4004# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005!$acc exit data delete(stored_values)
4006# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007#elif defined(MFC_OpenMP)
4008# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009!$omp target exit data map(release:stored_values)
4010# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011#endif
4012# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 deallocate (stored_values)
4014# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015#ifdef MFC_DEBUG
4016# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 block
4018# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019 use iso_fortran_env, only: output_unit
4020# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021
4022# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(x_coords)'
4024# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025
4026# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 call flush (output_unit)
4028# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 end block
4030# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031#endif
4032# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033
4034# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035#if defined(MFC_OpenACC)
4036# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037!$acc exit data delete(x_coords)
4038# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039#elif defined(MFC_OpenMP)
4040# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041!$omp target exit data map(release:x_coords)
4042# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043#endif
4044# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 deallocate (x_coords)
4046# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047 end if
4048# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049
4050# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 if (allocated(y_coords)) then
4052# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053#ifdef MFC_DEBUG
4054# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 block
4056# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 use iso_fortran_env, only: output_unit
4058# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059
4060# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(y_coords)'
4062# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063
4064# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065 call flush (output_unit)
4066# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067 end block
4068# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069#endif
4070# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071
4072# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073#if defined(MFC_OpenACC)
4074# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075!$acc exit data delete(y_coords)
4076# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077#elif defined(MFC_OpenMP)
4078# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079!$omp target exit data map(release:y_coords)
4080# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081#endif
4082# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083 deallocate (y_coords)
4084# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085 end if
4086# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087
4088# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089 files_loaded = .false.
4090# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091
4092# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 if (allocated(stored_values274)) then
4094# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095#ifdef MFC_DEBUG
4096# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 block
4098# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099 use iso_fortran_env, only: output_unit
4100# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101
4102# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(stored_values274)'
4104# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105
4106# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 call flush (output_unit)
4108# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109 end block
4110# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111#endif
4112# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113
4114# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115#if defined(MFC_OpenACC)
4116# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117!$acc exit data delete(stored_values274)
4118# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119#elif defined(MFC_OpenMP)
4120# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121!$omp target exit data map(release:stored_values274)
4122# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123#endif
4124# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125 deallocate (stored_values274)
4126# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127 end if
4128# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129
4130# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131 files_loaded274 = .false.
4132
4133 end subroutine s_icpp_spiral
4134
4135 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
4136 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
4137 !! its boundary.
4138 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
4139
4140 integer, intent(in) :: patch_id
4141
4142#ifdef MFC_MIXED_PRECISION
4143 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4144#else
4145 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4146#endif
4147 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
4148 real(wp) :: radius
4149 integer :: i, j, k !< Generic loop iterators
4150
4151 integer :: xRows, yRows, nRows, iix, iiy, max_files
4152# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
4154# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 real(wp) :: x_step, y_step
4156# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
4158# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
4160# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161 real(wp) :: delta_x, delta_y
4162# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
4164# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165 real(wp), allocatable :: stored_values(:,:,:)
4166# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 real(wp), allocatable :: x_coords(:), y_coords(:)
4168# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 logical :: files_loaded = .false.
4170# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 real(wp) :: domain_xstart
4172# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173 character(len=20) :: file_num_str !< For storing the file number as a string
4174# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 integer :: ios
4176# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177 integer :: ios2
4178# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179
4180# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
4182# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
4184# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
4186# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187 ! y_coords/files_loaded above.
4188# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 real(wp), allocatable, dimension(:,:,:) :: stored_values274
4190# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 logical :: files_loaded274 = .false.
4192# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 integer :: f274, ix274, iy274, unit274, ios274
4194# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195 integer :: local_ix_beg274, local_iy_beg274
4196# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 character(len=300) :: fname274
4198# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 character(len=20) :: file_num_str274
4200# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
4202# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 real(wp) :: file_dx274, file_dy274, r_align274
4204 ! Place any declaration of intermediate variables here
4205# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4206 real(wp) :: eps, eps_mhd, C_mhd
4207# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4208 real(wp) :: r, rmax, gam, umax, p0
4209# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4210 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
4211# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4212 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
4213# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4214 real(wp) :: r0, alpha, r2
4215# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4216 real(wp) :: sinA, cosA
4217# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4218 real(wp) :: r_sq
4219# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4220
4221# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4222 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
4223# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4224 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
4225# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4226 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
4227# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4228 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
4229# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4230 integer :: igq, jgq
4231# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4232
4233# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4234 ! # 291 - Shear/Thermal Layer Case
4235# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4236 real(wp) :: delta_shear, u_max, u_mean
4237# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4238 real(wp) :: T_wall, T_inf, P_atm, T_loc
4239# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4240 real(wp) :: delta_th, R_mix
4241# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4242 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
4243# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4244 real(wp) :: bottom_blend_u, bottom_blend_T
4245# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4246
4247# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4248 ! # 207
4249# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4250 real(wp) :: sigma, gauss1, gauss2
4251# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4252
4253# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4254 ! # 208
4255# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4256 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
4257# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4258 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
4259# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4260 integer :: v, idx_lo, idx_hi, idx_mid
4261# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4262 real(wp), parameter :: Ly_param = 0.00775735_wp
4263# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4264 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
4265# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4266 integer, parameter :: Nwaves = 6
4267# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4268 real(wp), parameter :: y0_ref = 0.0_wp
4269# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4270
4271# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4272 eps = 1.e-9_wp
4273
4274 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
4275
4276 x_centroid = patch_icpp(patch_id)%x_centroid
4277 y_centroid = patch_icpp(patch_id)%y_centroid
4278 radius = patch_icpp(patch_id)%radius
4279 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
4280 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
4281
4282 ! Initialize eta=1; modified if smoothing is enabled
4283 eta = 1._wp
4284
4285 ! Assign patch vars if cell is covered and patch has write permission
4286
4287 do j = 0, n
4288 do i = 0, m
4289 if (patch_icpp(patch_id)%smoothen) then
4290 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
4291 eta = tanh(smooth_coeff/min(dx_min, &
4292 & dy_min)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
4293 end if
4294
4295 if ((f_is_inside_cylinder(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, radius, &
4296 & 0._wp) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
4297 & 0) == smooth_patch_id) then
4298 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
4299
4300
4301 if (patch_icpp(patch_id)%hcid /= dflt_int) then
4302 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
4303# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4304 case (200) ! Two-fluid cubic interface
4305# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4306 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
4307# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4308 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
4309# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4310 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
4311# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4312 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
4313# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4314 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
4315# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4316 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
4317# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4318 end if
4319# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4320 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
4321# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4322 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4323# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4324 rmax = 0.2_wp
4325# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4326
4327# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4328 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4329# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4330 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4331# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4332 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4333# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4334
4335# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4336 if (r < rmax) then
4337# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4338 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4339# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4340 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4341# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4342 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4343# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4344 else if (r < 2*rmax) then
4345# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4346 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4347# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4348 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4349# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4350 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)))
4351# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4352 else
4353# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4354 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4355# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4356 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4357# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4358 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
4359# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4360 end if
4361# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4362 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
4363# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4364 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4365# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4366 rmax = 0.2_wp
4367# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4368
4369# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4370 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4371# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4372 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4373# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4374 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4375# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4376
4377# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4378 if (r < rmax) then
4379# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4380 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4381# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4382 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4383# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4384 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4385# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4386 else if (r < 2*rmax) then
4387# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4388 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4389# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4390 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4391# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4392 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)))
4393# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4394 else
4395# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4396 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4397# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4398 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4399# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4400 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
4401# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4402 end if
4403# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4404
4405# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4406 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
4407# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4408 case (204) ! Rayleigh-Taylor instability
4409# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4410 rhoh = 3._wp
4411# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4412 rhol = 1._wp
4413# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4414 pref = 1.e5_wp
4415# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4416 pint = pref
4417# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4418 h = 0.7_wp
4419# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4420 lam = 0.2_wp
4421# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4422 wl = 2._wp*pi/lam
4423# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4424 amp = 0.05_wp/wl
4425# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4426
4427# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4428 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
4429# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4430
4431# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4432 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4433# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4434
4435# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4436 if (alph < eps) alph = eps
4437# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4438 if (alph > 1._wp - eps) alph = 1._wp - eps
4439# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4440
4441# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4442 if (y_cc(j) > inth) then
4443# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4444 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4445# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4446 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4447# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4448 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4449# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4450 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4451# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4452 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4453# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4454 else
4455# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4456 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4457# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4458 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4459# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4460 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4461# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4462 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4463# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4464 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4465# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4466 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
4467# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4468 end if
4469# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4470 case (205) ! 2D lung wave interaction problem
4471# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4472 h = 0.0_wp ! non dim origin y
4473# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4474 lam = 1.0_wp ! non dim lambda
4475# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4476 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
4477# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4478
4479# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4480 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
4481# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4482
4483# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4484 if (y_cc(j) > inth) then
4485# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4486 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4487# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4488 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4489# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4490 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4491# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4492 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4493# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4494 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4495# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4496 end if
4497# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4498 case (206) ! 2D lung wave interaction problem - horizontal domain
4499# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4500 h = 0.0_wp ! non dim origin y
4501# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4502 lam = 1.0_wp ! non dim lambda
4503# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4504 amp = patch_icpp(patch_id)%a(2)
4505# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4506
4507# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4508 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4509# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4510
4511# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4512 if (x_cc(i) > intl) then ! this is the liquid
4513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4514 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4516 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4518 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4520 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4522 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4524 end if
4525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4526 case (207) ! Kelvin Helmholtz Instability
4527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4528 sigma = 0.05_wp/sqrt(2.0_wp)
4529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4530 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4532 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4534 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)
4535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4536 case (208) ! Richtmeyer Meshkov Instability
4537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4538 lam = 1.0_wp
4539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4540 eps = 1.0e-6_wp
4541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4542 ei = 5.0_wp
4543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4544 ! Smoothening function to smooth out sharp discontinuity in the interface
4545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4546 if (x_cc(i) <= 0.7_wp*lam) then
4547# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4548 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4549# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4550 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
4551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4552 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4553# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4554 alpha_sf6 = 1.0_wp - alpha_air
4555# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4556 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
4557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4558 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
4559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4560 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
4561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4562 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
4563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4564 end if
4565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4566 case (250) ! MHD Orszag-Tang vortex
4567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4568 ! 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),
4569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4570 ! sin(4*pi*x)/sqrt(4*pi), 0)
4571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4572
4573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4574 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4576 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4577# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4578
4579# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4580 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4582 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4584 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4586 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4588 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
4589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4590 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
4591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4592 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4593# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4594 ! Linear interpolation between r=0.08 and r=1.0
4595# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4596 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4598 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4600 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4602 else
4603# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4604 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
4605# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4606 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
4607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4608 end if
4609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4610
4611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4612 ! case 252 is for the 2D MHD Rotor problem
4613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4614 case (252) ! 2D MHD Rotor Problem
4615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4616 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
4617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4618 !
4619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4620 ! 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
4621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4622 ! velocity w=20, giving v_tan=2 at r=0.1
4623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4624
4625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4626 ! Calculate distance squared from the center
4627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4628 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4630
4631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4632 ! inner radius of 0.1
4633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4634 if (r_sq <= 0.1**2) then
4635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4636 ! -- Inside the rotor -- Set density uniformly to 10
4637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4638 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
4639# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4640
4641# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4642 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
4643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4644 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4646 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4648
4649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4650 ! taper width of 0.015
4651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4652 else if (r_sq <= 0.115**2) then
4653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4654 ! linearly smooth the function between r = 0.1 and 0.115
4655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4656 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4658
4659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4660 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)
4661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4662 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)
4663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4664 end if
4665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4666 case (253) ! MHD Smooth Magnetic Vortex
4667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4668 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
4669# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4670 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4671# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4672
4673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4674 ! velocity
4675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4676 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))
4677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4678 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))
4679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4680
4681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4682 ! magnetic field
4683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4684 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)
4685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4686 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)
4687# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4688
4689# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4690 ! pressure
4691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4692 q_prim_vf(eqn_idx%E)%sf(i, j, &
4693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4694 & 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)
4695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4696 case (260) ! Gaussian Divergence Pulse
4697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4698 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
4699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4700 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
4701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4702 ! initialized to zero everywhere.
4703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4704
4705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4706 eps_mhd = patch_icpp(patch_id)%a(2)
4707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4708 sigma = patch_icpp(patch_id)%a(3)
4709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4710 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4712
4713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4714 ! B-field
4715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4716 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4718 case (261) ! Blob
4719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4720 r0 = 1._wp/sqrt(8._wp)
4721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4722 r2 = x_cc(i)**2 + y_cc(j)**2
4723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4724 r = sqrt(r2)
4725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4726 alpha = r/r0
4727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4728 if (alpha < 1) then
4729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4730 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)
4731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4732 ! 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)
4733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4734 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4736 ! 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
4737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4738 end if
4739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4740 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
4741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4742 ! rotate by \alpha = atan(2)
4743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4744 alpha = atan(2._wp)
4745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4746 cosa = cos(alpha)
4747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4748 sina = sin(alpha)
4749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4750 ! projection along shock normal
4751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4752 r = x_cc(i)*cosa + y_cc(j)*sina
4753# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4754
4755# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4756 if (r <= 0.5_wp) then
4757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4758 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4760 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4762 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
4763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4764 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
4765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4766 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
4767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4768 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
4769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4770 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
4771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4772 else
4773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4774 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4776 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4778 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
4779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4780 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
4781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4782 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
4783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4784 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
4785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4786 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
4787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4788 end if
4789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4790 ! v^z and B^z remain zero by default
4791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4792 case (270) ! 2D extrusion of 1D profile from external data
4793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4794 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4796 if (.not. files_loaded) then
4797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4798 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4800 do f = 1, max_files
4801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4802 write (file_num_str, '(I0)') f
4803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4804 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
4805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4806 end do
4807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4808
4809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4810 ! Common file reading setup
4811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4812 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4814 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
4815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4816
4817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4818 select case (num_dims)
4819# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4820 case (1, 2) ! 1D and 2D cases are similar
4821# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4822 ! Count lines
4823# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4824 line_count = 0
4825# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4826 do
4827# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4828 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4829# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4830 if (ios2 /= 0) exit
4831# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4832 line_count = line_count + 1
4833# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4834 end do
4835# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4836 close (unit2)
4837# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4838
4839# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4840 xrows = line_count
4841# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4842 yrows = 1
4843# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4844 index_x = 0
4845# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4846 if (num_dims == 2) index_x = i
4847# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4848#ifdef MFC_DEBUG
4849# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4850 block
4851# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4852 use iso_fortran_env, only: output_unit
4853# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4854
4855# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4856 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4857# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4858
4859# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4860 call flush (output_unit)
4861# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4862 end block
4863# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4864#endif
4865# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4866 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4867# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4868
4869# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4870
4871# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4872
4873# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4874#if defined(MFC_OpenACC)
4875# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4876!$acc enter data create(x_coords, stored_values)
4877# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4878#elif defined(MFC_OpenMP)
4879# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4880!$omp target enter data map(always,alloc:x_coords, stored_values)
4881# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4882#endif
4883# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4884
4885# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4886 ! Read data from all files
4887# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4888 do f = 1, max_files
4889# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4890 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4891# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4892 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
4893# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4894
4895# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4896 do iter = 1, xrows
4897# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4898 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4899# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4900 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
4901# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4902 end do
4903# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4904 close (unit)
4905# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4906 end do
4907# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4908
4909# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4910 ! Calculate offsets
4911# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4912 domain_xstart = x_coords(1)
4913# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4914 x_step = x_cc(1) - x_cc(0)
4915# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4916 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
4917# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4918 global_offset_x = nint(abs(delta_x)/x_step)
4919# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4920 case (3) ! 3D case - determine grid structure
4921# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4922 ! Find yRows by counting rows with same x
4923# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4924 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4925# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4926 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4927# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4928
4929# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4930 yrows = 1
4931# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4932 do
4933# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4934 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4935# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4936 if (ios2 /= 0) exit
4937# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4938 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
4939# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4940 yrows = yrows + 1
4941# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4942 else
4943# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4944 exit
4945# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4946 end if
4947# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4948 end do
4949# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4950 close (unit2)
4951# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4952
4953# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4954 ! Count total rows
4955# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4956 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4957# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4958 nrows = 0
4959# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4960 do
4961# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4962 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4963# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4964 if (ios2 /= 0) exit
4965# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4966 nrows = nrows + 1
4967# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4968 end do
4969# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4970 close (unit2)
4971# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4972
4973# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4974 xrows = nrows/yrows
4975# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4976#ifdef MFC_DEBUG
4977# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4978 block
4979# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4980 use iso_fortran_env, only: output_unit
4981# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4982
4983# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4984 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4985# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4986
4987# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4988 call flush (output_unit)
4989# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4990 end block
4991# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4992#endif
4993# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4994 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4995# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4996
4997# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4998
4999# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5000
5001# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5002
5003# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5004#if defined(MFC_OpenACC)
5005# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5006!$acc enter data create(x_coords, y_coords, stored_values)
5007# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5008#elif defined(MFC_OpenMP)
5009# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5010!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5011# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012#endif
5013# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 index_x = i
5015# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 index_y = j
5017# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018
5019# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020 ! Read all files
5021# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022 do f = 1, max_files
5023# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5025# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026 if (ios /= 0) then
5027# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5029# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030 cycle
5031# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032 end if
5033# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034
5035# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036 iter = 0
5037# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038 do iix = 1, xrows
5039# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040 do iiy = 1, yrows
5041# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042 iter = iter + 1
5043# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044 if (f == 1) then
5045# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5047# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048 else
5049# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5051# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052 end if
5053# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054 if (ios /= 0) call s_mpi_abort("Error reading data")
5055# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056 end do
5057# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058 end do
5059# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060 close (unit)
5061# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062 end do
5063# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064
5065# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066 ! Calculate offsets
5067# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068 x_step = x_cc(1) - x_cc(0)
5069# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5070 y_step = y_cc(1) - y_cc(0)
5071# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5072 delta_x = x_cc(index_x) - x_coords(1)
5073# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5074 delta_y = y_cc(index_y) - y_coords(1)
5075# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5076 global_offset_x = nint(abs(delta_x)/x_step)
5077# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5078 global_offset_y = nint(abs(delta_y)/y_step)
5079# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5080 end select
5081# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5082
5083# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5084 files_loaded = .true.
5085# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5086 end if
5087# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5088
5089# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5090 ! Data assignment
5091# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5092 select case (num_dims)
5093# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5094 case (1)
5095# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5096 idx = i + 1 + global_offset_x
5097# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5098 ! idx must land inside the file's row range: this rank's subdomain offset
5099# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5100 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
5101# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5102 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
5103# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5104 if (idx < 1 .or. idx > xrows) &
5105# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5106 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5107# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5108 do f = 1, sys_size
5109# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5110 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5111# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5112 end do
5113# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5114 case (2)
5115# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5116 idx = i + 1 + global_offset_x - index_x
5117# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5118 if (idx < 1 .or. idx > xrows) &
5119# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5120 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5121# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5122 do f = 1, sys_size - 1
5123# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5124 jump = merge(1, 0, f >= eqn_idx%mom%end)
5125# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5126 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5127# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5128 end do
5129# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5130 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5131# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5132 case (3)
5133# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5134 idx = i + 1 + global_offset_x - index_x
5135# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5136 idy = j + 1 + global_offset_y - index_y
5137# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5138 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
5139# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5140 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
5141# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5142 do f = 1, sys_size - 1
5143# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5144 jump = merge(1, 0, f >= eqn_idx%mom%end)
5145# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5146 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5147# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5148 end do
5149# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5150 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5151# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5152 end select
5153# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5154 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
5155# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5156 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
5157# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5158 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
5159# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5160 ! cross-stream-position profile (real cross-stream velocity is legitimately
5161# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5162 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
5163# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5164 ! zero out mom%beg's true physical value.
5165# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5166 if (.not. files_loaded) then
5167# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5168 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5169# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5170 do f = 1, max_files
5171# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5172 write (file_num_str, '(I0)') f
5173# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5174 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
5175# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5176 end do
5177# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5178
5179# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5180 ! Common file reading setup
5181# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5182 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5183# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5184 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5185# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5186
5187# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5188 select case (num_dims)
5189# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5190 case (1, 2) ! 1D and 2D cases are similar
5191# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5192 ! Count lines
5193# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5194 line_count = 0
5195# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5196 do
5197# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5198 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5199# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5200 if (ios2 /= 0) exit
5201# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5202 line_count = line_count + 1
5203# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5204 end do
5205# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5206 close (unit2)
5207# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5208
5209# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5210 xrows = line_count
5211# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5212 yrows = 1
5213# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5214 index_x = 0
5215# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5216 if (num_dims == 2) index_x = i
5217# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5218#ifdef MFC_DEBUG
5219# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5220 block
5221# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5222 use iso_fortran_env, only: output_unit
5223# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5224
5225# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5226 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5227# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5228
5229# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5230 call flush (output_unit)
5231# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5232 end block
5233# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5234#endif
5235# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5236 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5237# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5238
5239# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5240
5241# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5242
5243# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5244#if defined(MFC_OpenACC)
5245# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5246!$acc enter data create(x_coords, stored_values)
5247# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5248#elif defined(MFC_OpenMP)
5249# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5250!$omp target enter data map(always,alloc:x_coords, stored_values)
5251# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5252#endif
5253# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5254
5255# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5256 ! Read data from all files
5257# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5258 do f = 1, max_files
5259# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5260 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5261# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5262 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5263# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5264
5265# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5266 do iter = 1, xrows
5267# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5268 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5269# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5270 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5271# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5272 end do
5273# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5274 close (unit)
5275# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5276 end do
5277# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5278
5279# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5280 ! Calculate offsets
5281# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5282 domain_xstart = x_coords(1)
5283# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5284 x_step = x_cc(1) - x_cc(0)
5285# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5286 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
5287# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5288 global_offset_x = nint(abs(delta_x)/x_step)
5289# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5290 case (3) ! 3D case - determine grid structure
5291# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5292 ! Find yRows by counting rows with same x
5293# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5294 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5295# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5296 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5297# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5298
5299# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5300 yrows = 1
5301# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5302 do
5303# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5304 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5305# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5306 if (ios2 /= 0) exit
5307# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5308 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5309# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5310 yrows = yrows + 1
5311# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5312 else
5313# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5314 exit
5315# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5316 end if
5317# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5318 end do
5319# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5320 close (unit2)
5321# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5322
5323# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5324 ! Count total rows
5325# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5326 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5327# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5328 nrows = 0
5329# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5330 do
5331# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5332 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5333# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5334 if (ios2 /= 0) exit
5335# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5336 nrows = nrows + 1
5337# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5338 end do
5339# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5340 close (unit2)
5341# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5342
5343# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5344 xrows = nrows/yrows
5345# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5346#ifdef MFC_DEBUG
5347# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5348 block
5349# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5350 use iso_fortran_env, only: output_unit
5351# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5352
5353# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5354 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5355# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5356
5357# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5358 call flush (output_unit)
5359# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5360 end block
5361# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5362#endif
5363# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5364 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5365# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5366
5367# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5368
5369# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5370
5371# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5372
5373# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5374#if defined(MFC_OpenACC)
5375# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5376!$acc enter data create(x_coords, y_coords, stored_values)
5377# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5378#elif defined(MFC_OpenMP)
5379# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5380!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5381# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5382#endif
5383# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5384 index_x = i
5385# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5386 index_y = j
5387# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5388
5389# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5390 ! Read all files
5391# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5392 do f = 1, max_files
5393# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5394 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5395# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5396 if (ios /= 0) then
5397# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5398 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5399# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5400 cycle
5401# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5402 end if
5403# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5404
5405# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5406 iter = 0
5407# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5408 do iix = 1, xrows
5409# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5410 do iiy = 1, yrows
5411# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5412 iter = iter + 1
5413# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5414 if (f == 1) then
5415# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5416 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5417# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5418 else
5419# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5420 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5421# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5422 end if
5423# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5424 if (ios /= 0) call s_mpi_abort("Error reading data")
5425# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5426 end do
5427# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5428 end do
5429# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5430 close (unit)
5431# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5432 end do
5433# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5434
5435# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5436 ! Calculate offsets
5437# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5438 x_step = x_cc(1) - x_cc(0)
5439# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5440 y_step = y_cc(1) - y_cc(0)
5441# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5442 delta_x = x_cc(index_x) - x_coords(1)
5443# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5444 delta_y = y_cc(index_y) - y_coords(1)
5445# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5446 global_offset_x = nint(abs(delta_x)/x_step)
5447# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5448 global_offset_y = nint(abs(delta_y)/y_step)
5449# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5450 end select
5451# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5452
5453# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5454 files_loaded = .true.
5455# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5456 end if
5457# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5458
5459# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5460 ! Data assignment
5461# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5462 select case (num_dims)
5463# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5464 case (1)
5465# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5466 idx = i + 1 + global_offset_x
5467# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5468 ! idx must land inside the file's row range: this rank's subdomain offset
5469# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5470 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
5471# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5472 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
5473# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5474 if (idx < 1 .or. idx > xrows) &
5475# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5476 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5477# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5478 do f = 1, sys_size
5479# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5480 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5481# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5482 end do
5483# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5484 case (2)
5485# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5486 idx = i + 1 + global_offset_x - index_x
5487# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5488 if (idx < 1 .or. idx > xrows) &
5489# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5490 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5491# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5492 do f = 1, sys_size - 1
5493# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5494 jump = merge(1, 0, f >= eqn_idx%mom%end)
5495# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5496 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5497# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5498 end do
5499# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5500 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5501# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5502 case (3)
5503# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5504 idx = i + 1 + global_offset_x - index_x
5505# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5506 idy = j + 1 + global_offset_y - index_y
5507# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5508 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
5509# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5510 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
5511# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5512 do f = 1, sys_size - 1
5513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5514 jump = merge(1, 0, f >= eqn_idx%mom%end)
5515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5516 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5518 end do
5519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5520 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5522 end select
5523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5524 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
5525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5526 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
5527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5528 case (274) ! Full 2D field from external data (no extrusion)
5529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5530 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
5531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5532 ! extrusion direction and no zeroed component -- all sys_size variables are read and
5533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5534 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
5535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5536 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
5537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5538 ! global grid exactly -- by construction, since the IC generator derives both the
5539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5540 ! grid and the file contents from the same computation.
5541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5542 !
5543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5544 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
5545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5546 ! file's own first coordinate and this rank's uniform grid spacing -- following the
5547# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5548 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
5549# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5550 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
5551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5552 ! returns before allocating it otherwise), so a serial-IO run (the default for
5553# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5554 ! golden-file tests) would index into an unallocated array.
5555# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5556 !
5557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5558 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
5559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5560 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
5561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5562 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
5563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5564 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
5565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5566 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
5567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5568 ! global cell offset) are pinned from f274==1's very first record, before any other
5569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5570 ! record is read, so every subsequent record -- across all variables -- can be tested
5571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5572 ! against this rank's range and dropped if it falls outside it.
5573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5574 x_step274 = x_cc(1) - x_cc(0)
5575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5576 y_step274 = y_cc(1) - y_cc(0)
5577# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5578
5579# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5580 if (.not. files_loaded274) then
5581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5582#ifdef MFC_DEBUG
5583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5584 block
5585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5586 use iso_fortran_env, only: output_unit
5587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5588
5589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5590 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
5591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5592
5593# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5594 call flush (output_unit)
5595# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5596 end block
5597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5598#endif
5599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5600 allocate (stored_values274(0:m, 0:n, sys_size))
5601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5602
5603# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5604
5605# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5606#if defined(MFC_OpenACC)
5607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5608!$acc enter data create(stored_values274)
5609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5610#elif defined(MFC_OpenMP)
5611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5612!$omp target enter data map(always,alloc:stored_values274)
5613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5614#endif
5615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5616 do f274 = 1, sys_size
5617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5618 write (file_num_str274, '(I0)') f274
5619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5620 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
5621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5622 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
5623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5624 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
5625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5626 do ix274 = 0, m_glb
5627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5628 do iy274 = 0, n_glb
5629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5630 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
5631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5632 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
5633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5634 ! Capture the file's own origin and spacing from its first records so we can
5635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5636 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
5637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5638 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
5639# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5640 if (f274 == 1) then
5641# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5642 if (ix274 == 0 .and. iy274 == 0) then
5643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5644 x0_274 = dummy_x274
5645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5646 y0_274 = dummy_y274
5647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5648 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
5649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5650 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
5651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5652 end if
5653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5654 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
5655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5656 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
5657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5658 end if
5659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5660 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
5661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5662 & .and. iy274 - local_iy_beg274 <= n) then
5663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5664 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
5665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5666 end if
5667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5668 end do
5669# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5670 end do
5671# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5672 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
5673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5674 ! read means it was generated for a larger grid and would be silently misread.
5675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5676 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
5677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5678 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
5679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5680 close (unit274)
5681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5682 end do
5683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5684
5685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5686 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
5687# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5688 ! Check alignment via the integer cell offset of this rank's first cell from the file
5689# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5690 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
5691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5692 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
5693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5694 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
5695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5696 ! the global origin.) The spacing checks below must also hold.
5697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5698 r_align274 = (x_cc(0) - x0_274)/x_step274
5699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5700 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
5701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5702 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
5703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5704 if (m_glb >= 1) then
5705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5706 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
5707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5708 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
5709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5710 end if
5711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5712 if (n_glb >= 1) then
5713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5714 r_align274 = (y_cc(0) - y0_274)/y_step274
5715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5716 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
5717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5718 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
5719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5720 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
5721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5722 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
5723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5724 end if
5725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5726
5727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5728 files_loaded274 = .true.
5729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5730 end if
5731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5732 ! Alignment is verified above (or this rank would already have aborted), so the local
5733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5734 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
5735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5736 do f274 = 1, sys_size
5737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5738 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
5739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5740 end do
5741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5742 case (271) ! Premixed Flame Vortices Interaction
5743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5744 if (.not. files_loaded) then
5745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5746 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5748 do f = 1, max_files
5749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5750 write (file_num_str, '(I0)') f
5751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5752 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
5753# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5754 end do
5755# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5756
5757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5758 ! Common file reading setup
5759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5760 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5762 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5764
5765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5766 select case (num_dims)
5767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5768 case (1, 2) ! 1D and 2D cases are similar
5769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5770 ! Count lines
5771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5772 line_count = 0
5773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5774 do
5775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5776 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5778 if (ios2 /= 0) exit
5779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5780 line_count = line_count + 1
5781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5782 end do
5783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5784 close (unit2)
5785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5786
5787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5788 xrows = line_count
5789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5790 yrows = 1
5791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5792 index_x = 0
5793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5794 if (num_dims == 2) index_x = i
5795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5796#ifdef MFC_DEBUG
5797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5798 block
5799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5800 use iso_fortran_env, only: output_unit
5801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5802
5803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5804 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5806
5807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5808 call flush (output_unit)
5809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5810 end block
5811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5812#endif
5813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5814 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5816
5817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5818
5819# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5820
5821# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5822#if defined(MFC_OpenACC)
5823# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5824!$acc enter data create(x_coords, stored_values)
5825# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5826#elif defined(MFC_OpenMP)
5827# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5828!$omp target enter data map(always,alloc:x_coords, stored_values)
5829# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5830#endif
5831# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5832
5833# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5834 ! Read data from all files
5835# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5836 do f = 1, max_files
5837# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5838 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5839# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5840 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5841# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5842
5843# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5844 do iter = 1, xrows
5845# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5846 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5847# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5848 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5849# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5850 end do
5851# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5852 close (unit)
5853# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5854 end do
5855# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5856
5857# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5858 ! Calculate offsets
5859# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5860 domain_xstart = x_coords(1)
5861# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5862 x_step = x_cc(1) - x_cc(0)
5863# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5864 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
5865# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5866 global_offset_x = nint(abs(delta_x)/x_step)
5867# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5868 case (3) ! 3D case - determine grid structure
5869# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5870 ! Find yRows by counting rows with same x
5871# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5872 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5873# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5874 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5875# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5876
5877# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5878 yrows = 1
5879# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5880 do
5881# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5882 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5883# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5884 if (ios2 /= 0) exit
5885# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5886 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5887# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5888 yrows = yrows + 1
5889# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5890 else
5891# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5892 exit
5893# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5894 end if
5895# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5896 end do
5897# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5898 close (unit2)
5899# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5900
5901# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5902 ! Count total rows
5903# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5904 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5905# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5906 nrows = 0
5907# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5908 do
5909# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5910 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5911# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5912 if (ios2 /= 0) exit
5913# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5914 nrows = nrows + 1
5915# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5916 end do
5917# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5918 close (unit2)
5919# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5920
5921# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5922 xrows = nrows/yrows
5923# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5924#ifdef MFC_DEBUG
5925# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5926 block
5927# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5928 use iso_fortran_env, only: output_unit
5929# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5930
5931# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5932 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5933# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5934
5935# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5936 call flush (output_unit)
5937# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5938 end block
5939# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5940#endif
5941# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5942 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5943# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5944
5945# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5946
5947# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5948
5949# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5950
5951# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5952#if defined(MFC_OpenACC)
5953# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5954!$acc enter data create(x_coords, y_coords, stored_values)
5955# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5956#elif defined(MFC_OpenMP)
5957# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5958!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5959# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5960#endif
5961# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5962 index_x = i
5963# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5964 index_y = j
5965# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5966
5967# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5968 ! Read all files
5969# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5970 do f = 1, max_files
5971# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5972 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5973# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5974 if (ios /= 0) then
5975# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5976 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5977# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5978 cycle
5979# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5980 end if
5981# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5982
5983# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5984 iter = 0
5985# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5986 do iix = 1, xrows
5987# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5988 do iiy = 1, yrows
5989# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5990 iter = iter + 1
5991# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5992 if (f == 1) then
5993# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5994 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5995# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5996 else
5997# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5998 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5999# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6000 end if
6001# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6002 if (ios /= 0) call s_mpi_abort("Error reading data")
6003# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6004 end do
6005# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6006 end do
6007# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6008 close (unit)
6009# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6010 end do
6011# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6012
6013# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6014 ! Calculate offsets
6015# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6016 x_step = x_cc(1) - x_cc(0)
6017# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6018 y_step = y_cc(1) - y_cc(0)
6019# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6020 delta_x = x_cc(index_x) - x_coords(1)
6021# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6022 delta_y = y_cc(index_y) - y_coords(1)
6023# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6024 global_offset_x = nint(abs(delta_x)/x_step)
6025# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026 global_offset_y = nint(abs(delta_y)/y_step)
6027# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028 end select
6029# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030
6031# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 files_loaded = .true.
6033# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034 end if
6035# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6036
6037# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6038 ! Data assignment
6039# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 select case (num_dims)
6041# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 case (1)
6043# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 idx = i + 1 + global_offset_x
6045# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6046 ! idx must land inside the file's row range: this rank's subdomain offset
6047# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6048 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
6049# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6050 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
6051# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6052 if (idx < 1 .or. idx > xrows) &
6053# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6055# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6056 do f = 1, sys_size
6057# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6058 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6059# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6060 end do
6061# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6062 case (2)
6063# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6064 idx = i + 1 + global_offset_x - index_x
6065# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6066 if (idx < 1 .or. idx > xrows) &
6067# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6068 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6069# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6070 do f = 1, sys_size - 1
6071# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6072 jump = merge(1, 0, f >= eqn_idx%mom%end)
6073# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6074 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6075# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6076 end do
6077# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6078 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6079# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6080 case (3)
6081# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6082 idx = i + 1 + global_offset_x - index_x
6083# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6084 idy = j + 1 + global_offset_y - index_y
6085# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6086 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
6087# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6088 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
6089# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6090 do f = 1, sys_size - 1
6091# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6092 jump = merge(1, 0, f >= eqn_idx%mom%end)
6093# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6094 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6095# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6096 end do
6097# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6098 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6099# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6100 end select
6101# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6102 x1c = 0.0027_wp
6103# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6104 y1c = 0.005_wp
6105# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6106 x2c = 0.0027_wp
6107# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6108 y2c = 0.003_wp
6109# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6110 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
6111# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6112 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
6113# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6114 rvortex = 0.0005_wp
6115# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6116 cvortex = 6000.0_wp
6117# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6118
6119# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6120 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
6121# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6122 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
6123# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6124
6125# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6126 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
6127# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6128 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
6129# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6130 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
6131# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6132 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
6133# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6134 case (272) ! Premixed Flame Instability
6135# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6136 if (.not. files_loaded) then
6137# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6138 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6139# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6140 do f = 1, max_files
6141# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142 write (file_num_str, '(I0)') f
6143# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
6145# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146 end do
6147# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6148
6149# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6150 ! Common file reading setup
6151# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6153# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6155# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156
6157# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158 select case (num_dims)
6159# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 case (1, 2) ! 1D and 2D cases are similar
6161# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162 ! Count lines
6163# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164 line_count = 0
6165# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166 do
6167# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6169# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 if (ios2 /= 0) exit
6171# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172 line_count = line_count + 1
6173# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174 end do
6175# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176 close (unit2)
6177# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178
6179# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 xrows = line_count
6181# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 yrows = 1
6183# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 index_x = 0
6185# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 if (num_dims == 2) index_x = i
6187# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188#ifdef MFC_DEBUG
6189# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 block
6191# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192 use iso_fortran_env, only: output_unit
6193# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194
6195# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6197# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198
6199# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 call flush (output_unit)
6201# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202 end block
6203# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204#endif
6205# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6207# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208
6209# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210
6211# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212
6213# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214#if defined(MFC_OpenACC)
6215# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216!$acc enter data create(x_coords, stored_values)
6217# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218#elif defined(MFC_OpenMP)
6219# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220!$omp target enter data map(always,alloc:x_coords, stored_values)
6221# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222#endif
6223# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224
6225# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226 ! Read data from all files
6227# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228 do f = 1, max_files
6229# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6231# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6233# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234
6235# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 do iter = 1, xrows
6237# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6239# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6241# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 end do
6243# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244 close (unit)
6245# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 end do
6247# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248
6249# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 ! Calculate offsets
6251# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252 domain_xstart = x_coords(1)
6253# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254 x_step = x_cc(1) - x_cc(0)
6255# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
6257# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258 global_offset_x = nint(abs(delta_x)/x_step)
6259# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260 case (3) ! 3D case - determine grid structure
6261# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 ! Find yRows by counting rows with same x
6263# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6265# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6267# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268
6269# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270 yrows = 1
6271# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 do
6273# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6275# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 if (ios2 /= 0) exit
6277# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6279# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280 yrows = yrows + 1
6281# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 else
6283# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284 exit
6285# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 end if
6287# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288 end do
6289# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 close (unit2)
6291# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292
6293# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 ! Count total rows
6295# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6297# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 nrows = 0
6299# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300 do
6301# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6303# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 if (ios2 /= 0) exit
6305# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 nrows = nrows + 1
6307# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308 end do
6309# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 close (unit2)
6311# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312
6313# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 xrows = nrows/yrows
6315# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316#ifdef MFC_DEBUG
6317# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318 block
6319# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 use iso_fortran_env, only: output_unit
6321# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322
6323# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6325# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326
6327# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 call flush (output_unit)
6329# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330 end block
6331# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332#endif
6333# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6335# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6336
6337# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6338
6339# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340
6341# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6342
6343# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6344#if defined(MFC_OpenACC)
6345# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346!$acc enter data create(x_coords, y_coords, stored_values)
6347# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348#elif defined(MFC_OpenMP)
6349# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6351# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352#endif
6353# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 index_x = i
6355# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356 index_y = j
6357# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358
6359# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360 ! Read all files
6361# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 do f = 1, max_files
6363# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6365# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 if (ios /= 0) then
6367# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6369# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370 cycle
6371# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 end if
6373# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374
6375# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 iter = 0
6377# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378 do iix = 1, xrows
6379# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 do iiy = 1, yrows
6381# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382 iter = iter + 1
6383# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 if (f == 1) then
6385# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6387# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 else
6389# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6391# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392 end if
6393# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 if (ios /= 0) call s_mpi_abort("Error reading data")
6395# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396 end do
6397# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 end do
6399# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 close (unit)
6401# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6402 end do
6403# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6404
6405# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 ! Calculate offsets
6407# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408 x_step = x_cc(1) - x_cc(0)
6409# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 y_step = y_cc(1) - y_cc(0)
6411# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412 delta_x = x_cc(index_x) - x_coords(1)
6413# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 delta_y = y_cc(index_y) - y_coords(1)
6415# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416 global_offset_x = nint(abs(delta_x)/x_step)
6417# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418 global_offset_y = nint(abs(delta_y)/y_step)
6419# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 end select
6421# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422
6423# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424 files_loaded = .true.
6425# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 end if
6427# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6428
6429# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6430 ! Data assignment
6431# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 select case (num_dims)
6433# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 case (1)
6435# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6436 idx = i + 1 + global_offset_x
6437# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 ! idx must land inside the file's row range: this rank's subdomain offset
6439# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
6441# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
6443# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 if (idx < 1 .or. idx > xrows) &
6445# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6447# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 do f = 1, sys_size
6449# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6451# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6452 end do
6453# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6454 case (2)
6455# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 idx = i + 1 + global_offset_x - index_x
6457# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458 if (idx < 1 .or. idx > xrows) &
6459# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6461# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462 do f = 1, sys_size - 1
6463# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464 jump = merge(1, 0, f >= eqn_idx%mom%end)
6465# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6467# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 end do
6469# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6471# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 case (3)
6473# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 idx = i + 1 + global_offset_x - index_x
6475# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 idy = j + 1 + global_offset_y - index_y
6477# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
6479# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
6481# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 do f = 1, sys_size - 1
6483# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484 jump = merge(1, 0, f >= eqn_idx%mom%end)
6485# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6487# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488 end do
6489# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6491# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 end select
6493# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494
6495# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 y_center = y0_ref
6497# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498 y_dist = y_cc(j) - y_center
6499# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
6501# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502 front_shift = a_param*sin(wave_phase)
6503# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6504
6505# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6506 x_mapped = x_cc(i) - front_shift
6507# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508
6509# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510 if (x_mapped <= x_coords(1)) then
6511# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512 do v = 1, sys_size - 1
6513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
6515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516 end do
6517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520 else if (x_mapped >= x_coords(xrows)) then
6521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522 do v = 1, sys_size - 1
6523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
6525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526 end do
6527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530 else
6531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532 idx_lo = 1; idx_hi = xrows
6533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534 do while (idx_hi - idx_lo > 1)
6535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536 idx_mid = (idx_lo + idx_hi)/2
6537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 if (x_coords(idx_mid) <= x_mapped) then
6539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540 idx_lo = idx_mid
6541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542 else
6543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544 idx_hi = idx_mid
6545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 end if
6547# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6548 end do
6549# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6550
6551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
6553# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6554
6555# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6556 do v = 1, sys_size - 1
6557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
6559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 & v) + interp_wt*stored_values(idx_hi, 1, v)
6561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 end do
6563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 end if
6567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
6569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
6571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
6573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
6575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
6577# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578 & - y_domain%beg))
6579# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580 if (x_cc(i) > d) then
6581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
6587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
6589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590 do v = eqn_idx%species%beg, eqn_idx%species%end
6591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
6593# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6594 end do
6595# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6596 end if
6597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598 case (280) ! Isentropic vortex
6599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602 ! geometry 2
6603# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604 if (patch_id == 1) then
6605# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 q_prim_vf(eqn_idx%E)%sf(i, j, &
6607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 & 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) &
6609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614 & 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) &
6615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 & 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) &
6621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
6625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 & 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) &
6627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 end if
6631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632 case (281) ! Acoustic pulse
6633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
6635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 ! geometry 2
6637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638 if (patch_id == 2) then
6639# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 q_prim_vf(eqn_idx%E)%sf(i, j, &
6641# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642 & 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))
6643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646 & 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))
6647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648 end if
6649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650 case (282) ! Zero-circulation vortex
6651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
6653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654 ! geometry 2
6655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656 if (patch_id == 2) then
6657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658 q_prim_vf(eqn_idx%E)%sf(i, j, &
6659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 & 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))
6661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664 & 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))
6665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6669# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
6671# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 end if
6675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
6677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
6679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
6681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
6683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 ! patch_icpp(patch_id)%epsilon; defaults to 5.
6685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 if (patch_id == 1) then
6687# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
6689# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
6691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
6693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
6695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696 do igq = 1, 3
6697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698 do jgq = 1, 3
6699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
6701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
6703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
6705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706 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))
6707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708 wq = gauss_w(igq)*gauss_w(jgq)
6709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710 rhoq = t_facq**1.4_wp
6711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712 pq = t_facq**2.4_wp
6713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
6715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716 & - r2q)
6717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
6719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720 & - r2q)
6721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
6723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724 rho_avg = rho_avg + wq*rhoq
6725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726 rhou_avg = rhou_avg + wq*(rhoq*uq)
6727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728 rhov_avg = rhov_avg + wq*(rhoq*vq)
6729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730 e_avg = e_avg + wq*eq
6731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732 end do
6733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734 end do
6735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736 rho_avg = rho_avg*0.25_wp
6737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738 rhou_avg = rhou_avg*0.25_wp
6739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 rhov_avg = rhov_avg*0.25_wp
6741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 e_avg = e_avg*0.25_wp
6743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
6745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
6747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
6749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
6751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 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
6753# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 end if
6755# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 case (291) ! Isothermal Flat Plate
6757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758 t_inf = 1125.0_wp
6759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 t_wall = 600.0_wp
6761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 p_atm = 101325.0_wp
6763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764
6765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 ! Boundary/Shear Layer thicknesses
6767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768 delta_th = 0.0003_wp ! Thermal BL thickness
6769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 delta_shear = 8e-3_wp ! Velocity BL thickness
6771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772
6773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 u_max = 50.0_wp ! Freestream Velocity (m/s)
6775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776
6777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 mw_n2 = 28.0134e-3_wp
6779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 mw_o2 = 31.999e-3_wp
6781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 y_n2 = 0.767_wp
6783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 y_o2 = 0.233_wp
6785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
6787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 bottom_blend_u = tanh(y_cc(j)/delta_shear)
6789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 bottom_blend_t = tanh(y_cc(j)/delta_th)
6791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 u_mean = u_max*bottom_blend_u
6793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
6795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
6797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
6799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
6803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
6805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
6807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808 case default
6809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 if (proc_rank == 0) then
6811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812 call s_int_to_str(patch_id, istr)
6813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
6815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816 end if
6817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 end select
6819 end if
6820 end if
6821 end do
6822 end do
6823 if (allocated(stored_values)) then
6824# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6825#ifdef MFC_DEBUG
6826# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6827 block
6828# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6829 use iso_fortran_env, only: output_unit
6830# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6831
6832# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6833 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(stored_values)'
6834# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6835
6836# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6837 call flush (output_unit)
6838# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6839 end block
6840# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6841#endif
6842# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6843
6844# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6845#if defined(MFC_OpenACC)
6846# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6847!$acc exit data delete(stored_values)
6848# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6849#elif defined(MFC_OpenMP)
6850# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6851!$omp target exit data map(release:stored_values)
6852# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6853#endif
6854# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6855 deallocate (stored_values)
6856# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6857#ifdef MFC_DEBUG
6858# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6859 block
6860# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6861 use iso_fortran_env, only: output_unit
6862# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6863
6864# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6865 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(x_coords)'
6866# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6867
6868# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6869 call flush (output_unit)
6870# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6871 end block
6872# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6873#endif
6874# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6875
6876# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6877#if defined(MFC_OpenACC)
6878# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6879!$acc exit data delete(x_coords)
6880# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6881#elif defined(MFC_OpenMP)
6882# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6883!$omp target exit data map(release:x_coords)
6884# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6885#endif
6886# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6887 deallocate (x_coords)
6888# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6889 end if
6890# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6891
6892# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6893 if (allocated(y_coords)) then
6894# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6895#ifdef MFC_DEBUG
6896# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6897 block
6898# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6899 use iso_fortran_env, only: output_unit
6900# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6901
6902# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6903 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(y_coords)'
6904# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6905
6906# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6907 call flush (output_unit)
6908# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6909 end block
6910# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6911#endif
6912# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6913
6914# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6915#if defined(MFC_OpenACC)
6916# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6917!$acc exit data delete(y_coords)
6918# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6919#elif defined(MFC_OpenMP)
6920# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6921!$omp target exit data map(release:y_coords)
6922# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6923#endif
6924# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6925 deallocate (y_coords)
6926# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6927 end if
6928# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6929
6930# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6931 files_loaded = .false.
6932# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6933
6934# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6935 if (allocated(stored_values274)) then
6936# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6937#ifdef MFC_DEBUG
6938# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6939 block
6940# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6941 use iso_fortran_env, only: output_unit
6942# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6943
6944# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6945 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(stored_values274)'
6946# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6947
6948# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6949 call flush (output_unit)
6950# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6951 end block
6952# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6953#endif
6954# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6955
6956# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6957#if defined(MFC_OpenACC)
6958# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6959!$acc exit data delete(stored_values274)
6960# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6961#elif defined(MFC_OpenMP)
6962# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6963!$omp target exit data map(release:stored_values274)
6964# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6965#endif
6966# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6967 deallocate (stored_values274)
6968# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6969 end if
6970# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6971
6972# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6973 files_loaded274 = .false.
6974
6975 end subroutine s_icpp_circle
6976
6977 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
6978 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
6979
6980 ! Patch identifier
6981 integer, intent(in) :: patch_id
6982
6983#ifdef MFC_MIXED_PRECISION
6984 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6985#else
6986 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
6987#endif
6988 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
6989
6990 ! Generic loop iterators
6991 integer :: i, j, k
6992 real(wp) :: radius, myr, thickness
6993
6994 integer :: xRows, yRows, nRows, iix, iiy, max_files
6995# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
6997# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998 real(wp) :: x_step, y_step
6999# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7001# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7003# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004 real(wp) :: delta_x, delta_y
7005# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7007# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008 real(wp), allocatable :: stored_values(:,:,:)
7009# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010 real(wp), allocatable :: x_coords(:), y_coords(:)
7011# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012 logical :: files_loaded = .false.
7013# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014 real(wp) :: domain_xstart
7015# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 character(len=20) :: file_num_str !< For storing the file number as a string
7017# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018 integer :: ios
7019# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 integer :: ios2
7021# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022
7023# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
7025# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
7027# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
7029# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 ! y_coords/files_loaded above.
7031# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032 real(wp), allocatable, dimension(:,:,:) :: stored_values274
7033# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034 logical :: files_loaded274 = .false.
7035# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036 integer :: f274, ix274, iy274, unit274, ios274
7037# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038 integer :: local_ix_beg274, local_iy_beg274
7039# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040 character(len=300) :: fname274
7041# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042 character(len=20) :: file_num_str274
7043# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
7045# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046 real(wp) :: file_dx274, file_dy274, r_align274
7047 ! Place any declaration of intermediate variables here
7048# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7049 real(wp) :: eps, eps_mhd, C_mhd
7050# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7051 real(wp) :: r, rmax, gam, umax, p0
7052# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7053 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
7054# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7055 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
7056# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7057 real(wp) :: r0, alpha, r2
7058# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7059 real(wp) :: sinA, cosA
7060# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7061 real(wp) :: r_sq
7062# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7063
7064# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7065 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
7066# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7067 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
7068# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7069 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
7070# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7071 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
7072# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7073 integer :: igq, jgq
7074# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7075
7076# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7077 ! # 291 - Shear/Thermal Layer Case
7078# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7079 real(wp) :: delta_shear, u_max, u_mean
7080# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7081 real(wp) :: T_wall, T_inf, P_atm, T_loc
7082# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7083 real(wp) :: delta_th, R_mix
7084# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7085 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
7086# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7087 real(wp) :: bottom_blend_u, bottom_blend_T
7088# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7089
7090# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7091 ! # 207
7092# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7093 real(wp) :: sigma, gauss1, gauss2
7094# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7095
7096# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7097 ! # 208
7098# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7099 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
7100# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7101 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
7102# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7103 integer :: v, idx_lo, idx_hi, idx_mid
7104# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7105 real(wp), parameter :: Ly_param = 0.00775735_wp
7106# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7107 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
7108# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7109 integer, parameter :: Nwaves = 6
7110# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7111 real(wp), parameter :: y0_ref = 0.0_wp
7112# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7113
7114# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7115 eps = 1.e-9_wp
7116
7117 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
7118 x_centroid = patch_icpp(patch_id)%x_centroid
7119 y_centroid = patch_icpp(patch_id)%y_centroid
7120 radius = patch_icpp(patch_id)%radius
7121 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7122 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7123 thickness = patch_icpp(patch_id)%epsilon
7124
7125 ! Initialize eta=1; modified if smoothing is enabled
7126 eta = 1._wp
7127
7128 ! Assign patch vars if cell is covered and patch has write permission
7129 do j = 0, n
7130 do i = 0, m
7131 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
7132
7133 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
7134 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
7135 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
7136
7137
7138 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7139 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
7140# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7141 case (200) ! Two-fluid cubic interface
7142# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7143 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
7144# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7145 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
7146# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7147 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
7148# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7149 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
7150# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7151 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
7152# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7153 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
7154# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7155 end if
7156# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7157 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
7158# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7159 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7160# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7161 rmax = 0.2_wp
7162# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7163
7164# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7165 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7166# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7167 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7168# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7169 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7170# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7171
7172# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7173 if (r < rmax) then
7174# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7175 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7176# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7177 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7178# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7179 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7180# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7181 else if (r < 2*rmax) then
7182# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7183 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7184# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7185 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7186# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7187 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)))
7188# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7189 else
7190# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7191 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
7192# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7193 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
7194# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7195 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
7196# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7197 end if
7198# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7199 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
7200# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7201 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7202# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7203 rmax = 0.2_wp
7204# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7205
7206# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7207 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7208# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7209 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7210# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7211 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7212# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7213
7214# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7215 if (r < rmax) then
7216# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7217 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7218# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7219 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7220# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7221 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7222# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7223 else if (r < 2*rmax) then
7224# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7225 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7226# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7227 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7228# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7229 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)))
7230# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7231 else
7232# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7233 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
7234# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7235 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
7236# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7237 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
7238# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7239 end if
7240# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7241
7242# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7243 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
7244# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7245 case (204) ! Rayleigh-Taylor instability
7246# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7247 rhoh = 3._wp
7248# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7249 rhol = 1._wp
7250# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7251 pref = 1.e5_wp
7252# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7253 pint = pref
7254# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7255 h = 0.7_wp
7256# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7257 lam = 0.2_wp
7258# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7259 wl = 2._wp*pi/lam
7260# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7261 amp = 0.05_wp/wl
7262# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7263
7264# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7265 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
7266# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7267
7268# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7269 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7270# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7271
7272# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7273 if (alph < eps) alph = eps
7274# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7275 if (alph > 1._wp - eps) alph = 1._wp - eps
7276# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7277
7278# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7279 if (y_cc(j) > inth) then
7280# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7281 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
7282# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7283 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
7284# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7285 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
7286# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7287 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
7288# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7289 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7290# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7291 else
7292# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7293 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
7294# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7295 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
7296# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7297 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
7298# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7299 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
7300# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7301 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7302# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7303 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
7304# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7305 end if
7306# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7307 case (205) ! 2D lung wave interaction problem
7308# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7309 h = 0.0_wp ! non dim origin y
7310# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7311 lam = 1.0_wp ! non dim lambda
7312# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7313 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
7314# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7315
7316# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7317 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
7318# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7319
7320# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7321 if (y_cc(j) > inth) then
7322# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7323 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7324# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7325 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7326# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7327 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
7328# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7329 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7330# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7331 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7332# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7333 end if
7334# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7335 case (206) ! 2D lung wave interaction problem - horizontal domain
7336# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7337 h = 0.0_wp ! non dim origin y
7338# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7339 lam = 1.0_wp ! non dim lambda
7340# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7341 amp = patch_icpp(patch_id)%a(2)
7342# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7343
7344# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7345 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
7346# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7347
7348# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7349 if (x_cc(i) > intl) then ! this is the liquid
7350# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7351 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7352# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7353 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7354# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7355 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
7356# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7357 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7358# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7359 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7360# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7361 end if
7362# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7363 case (207) ! Kelvin Helmholtz Instability
7364# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7365 sigma = 0.05_wp/sqrt(2.0_wp)
7366# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7367 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
7368# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7369 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
7370# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7371 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)
7372# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7373 case (208) ! Richtmeyer Meshkov Instability
7374# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7375 lam = 1.0_wp
7376# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7377 eps = 1.0e-6_wp
7378# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7379 ei = 5.0_wp
7380# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7381 ! Smoothening function to smooth out sharp discontinuity in the interface
7382# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7383 if (x_cc(i) <= 0.7_wp*lam) then
7384# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7385 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
7386# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7387 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
7388# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7389 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
7390# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7391 alpha_sf6 = 1.0_wp - alpha_air
7392# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7393 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
7394# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7395 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
7396# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7397 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
7398# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7399 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
7400# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7401 end if
7402# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7403 case (250) ! MHD Orszag-Tang vortex
7404# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7405 ! 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),
7406# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7407 ! sin(4*pi*x)/sqrt(4*pi), 0)
7408# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7409
7410# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7411 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
7412# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7413 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
7414# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7415
7416# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7417 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
7418# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7419 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
7420# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7421 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
7422# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7423 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
7424# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7425 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
7426# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7427 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
7428# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7429 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
7430# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7431 ! Linear interpolation between r=0.08 and r=1.0
7432# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7433 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
7434# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7435 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
7436# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7437 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
7438# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7439 else
7440# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7441 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
7442# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7443 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
7444# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7445 end if
7446# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7447
7448# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7449 ! case 252 is for the 2D MHD Rotor problem
7450# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7451 case (252) ! 2D MHD Rotor Problem
7452# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7453 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
7454# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7455 !
7456# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7457 ! 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
7458# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7459 ! velocity w=20, giving v_tan=2 at r=0.1
7460# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7461
7462# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7463 ! Calculate distance squared from the center
7464# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7465 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
7466# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7467
7468# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7469 ! inner radius of 0.1
7470# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7471 if (r_sq <= 0.1**2) then
7472# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7473 ! -- Inside the rotor -- Set density uniformly to 10
7474# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7475 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
7476# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7477
7478# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7479 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
7480# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7481 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
7482# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7483 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
7484# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7485
7486# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7487 ! taper width of 0.015
7488# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7489 else if (r_sq <= 0.115**2) then
7490# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7491 ! linearly smooth the function between r = 0.1 and 0.115
7492# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7493 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
7494# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7495
7496# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7497 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)
7498# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7499 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)
7500# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7501 end if
7502# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7503 case (253) ! MHD Smooth Magnetic Vortex
7504# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7505 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
7506# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7507 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
7508# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7509
7510# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7511 ! velocity
7512# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7513 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))
7514# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7515 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))
7516# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7517
7518# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7519 ! magnetic field
7520# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7521 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)
7522# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7523 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)
7524# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7525
7526# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7527 ! pressure
7528# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7529 q_prim_vf(eqn_idx%E)%sf(i, j, &
7530# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7531 & 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)
7532# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7533 case (260) ! Gaussian Divergence Pulse
7534# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7535 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
7536# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7537 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
7538# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7539 ! initialized to zero everywhere.
7540# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7541
7542# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7543 eps_mhd = patch_icpp(patch_id)%a(2)
7544# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7545 sigma = patch_icpp(patch_id)%a(3)
7546# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7547 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
7548# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7549
7550# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7551 ! B-field
7552# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7553 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
7554# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7555 case (261) ! Blob
7556# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7557 r0 = 1._wp/sqrt(8._wp)
7558# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7559 r2 = x_cc(i)**2 + y_cc(j)**2
7560# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7561 r = sqrt(r2)
7562# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7563 alpha = r/r0
7564# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7565 if (alpha < 1) then
7566# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7567 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)
7568# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7569 ! 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)
7570# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7571 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
7572# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7573 ! 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
7574# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7575 end if
7576# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7577 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
7578# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7579 ! rotate by \alpha = atan(2)
7580# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7581 alpha = atan(2._wp)
7582# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7583 cosa = cos(alpha)
7584# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7585 sina = sin(alpha)
7586# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7587 ! projection along shock normal
7588# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7589 r = x_cc(i)*cosa + y_cc(j)*sina
7590# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7591
7592# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7593 if (r <= 0.5_wp) then
7594# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7595 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
7596# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7597 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
7598# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7599 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
7600# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7601 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
7602# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7603 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
7604# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7605 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
7606# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7607 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
7608# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7609 else
7610# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7611 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
7612# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7613 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
7614# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7615 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
7616# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7617 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
7618# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7619 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
7620# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7621 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
7622# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7623 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
7624# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7625 end if
7626# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7627 ! v^z and B^z remain zero by default
7628# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7629 case (270) ! 2D extrusion of 1D profile from external data
7630# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7631 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
7632# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7633 if (.not. files_loaded) then
7634# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7635 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7636# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7637 do f = 1, max_files
7638# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7639 write (file_num_str, '(I0)') f
7640# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7641 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
7642# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7643 end do
7644# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7645
7646# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7647 ! Common file reading setup
7648# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7649 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7650# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7651 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7652# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7653
7654# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7655 select case (num_dims)
7656# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7657 case (1, 2) ! 1D and 2D cases are similar
7658# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7659 ! Count lines
7660# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7661 line_count = 0
7662# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7663 do
7664# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7665 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7666# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7667 if (ios2 /= 0) exit
7668# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7669 line_count = line_count + 1
7670# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7671 end do
7672# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7673 close (unit2)
7674# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7675
7676# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7677 xrows = line_count
7678# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7679 yrows = 1
7680# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7681 index_x = 0
7682# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7683 if (num_dims == 2) index_x = i
7684# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7685#ifdef MFC_DEBUG
7686# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7687 block
7688# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7689 use iso_fortran_env, only: output_unit
7690# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7691
7692# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7693 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7694# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7695
7696# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7697 call flush (output_unit)
7698# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7699 end block
7700# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7701#endif
7702# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7703 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7704# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7705
7706# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7707
7708# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7709
7710# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7711#if defined(MFC_OpenACC)
7712# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7713!$acc enter data create(x_coords, stored_values)
7714# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7715#elif defined(MFC_OpenMP)
7716# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7717!$omp target enter data map(always,alloc:x_coords, stored_values)
7718# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7719#endif
7720# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7721
7722# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7723 ! Read data from all files
7724# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7725 do f = 1, max_files
7726# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7727 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7728# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7729 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7730# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7731
7732# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7733 do iter = 1, xrows
7734# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7735 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7736# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7737 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
7738# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7739 end do
7740# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7741 close (unit)
7742# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7743 end do
7744# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7745
7746# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7747 ! Calculate offsets
7748# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7749 domain_xstart = x_coords(1)
7750# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7751 x_step = x_cc(1) - x_cc(0)
7752# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7753 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
7754# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7755 global_offset_x = nint(abs(delta_x)/x_step)
7756# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7757 case (3) ! 3D case - determine grid structure
7758# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7759 ! Find yRows by counting rows with same x
7760# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7761 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7762# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7763 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7764# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7765
7766# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7767 yrows = 1
7768# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7769 do
7770# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7771 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7772# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7773 if (ios2 /= 0) exit
7774# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7775 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
7776# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7777 yrows = yrows + 1
7778# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7779 else
7780# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7781 exit
7782# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7783 end if
7784# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7785 end do
7786# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7787 close (unit2)
7788# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7789
7790# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7791 ! Count total rows
7792# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7793 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7794# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7795 nrows = 0
7796# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7797 do
7798# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7799 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7800# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7801 if (ios2 /= 0) exit
7802# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7803 nrows = nrows + 1
7804# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7805 end do
7806# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7807 close (unit2)
7808# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7809
7810# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7811 xrows = nrows/yrows
7812# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7813#ifdef MFC_DEBUG
7814# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7815 block
7816# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7817 use iso_fortran_env, only: output_unit
7818# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7819
7820# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7821 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7822# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7823
7824# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7825 call flush (output_unit)
7826# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7827 end block
7828# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7829#endif
7830# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7831 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7832# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7833
7834# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7835
7836# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7837
7838# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7839
7840# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7841#if defined(MFC_OpenACC)
7842# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7843!$acc enter data create(x_coords, y_coords, stored_values)
7844# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7845#elif defined(MFC_OpenMP)
7846# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7847!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7848# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7849#endif
7850# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7851 index_x = i
7852# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7853 index_y = j
7854# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7855
7856# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7857 ! Read all files
7858# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7859 do f = 1, max_files
7860# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7861 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7862# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7863 if (ios /= 0) then
7864# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7865 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
7866# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7867 cycle
7868# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7869 end if
7870# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7871
7872# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7873 iter = 0
7874# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7875 do iix = 1, xrows
7876# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7877 do iiy = 1, yrows
7878# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7879 iter = iter + 1
7880# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7881 if (f == 1) then
7882# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7883 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7884# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7885 else
7886# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7887 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7888# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7889 end if
7890# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7891 if (ios /= 0) call s_mpi_abort("Error reading data")
7892# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7893 end do
7894# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7895 end do
7896# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7897 close (unit)
7898# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7899 end do
7900# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7901
7902# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7903 ! Calculate offsets
7904# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7905 x_step = x_cc(1) - x_cc(0)
7906# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7907 y_step = y_cc(1) - y_cc(0)
7908# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7909 delta_x = x_cc(index_x) - x_coords(1)
7910# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7911 delta_y = y_cc(index_y) - y_coords(1)
7912# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7913 global_offset_x = nint(abs(delta_x)/x_step)
7914# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7915 global_offset_y = nint(abs(delta_y)/y_step)
7916# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7917 end select
7918# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7919
7920# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7921 files_loaded = .true.
7922# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7923 end if
7924# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7925
7926# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7927 ! Data assignment
7928# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7929 select case (num_dims)
7930# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7931 case (1)
7932# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7933 idx = i + 1 + global_offset_x
7934# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7935 ! idx must land inside the file's row range: this rank's subdomain offset
7936# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7937 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
7938# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7939 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
7940# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7941 if (idx < 1 .or. idx > xrows) &
7942# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7943 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
7944# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7945 do f = 1, sys_size
7946# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7947 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
7948# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7949 end do
7950# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7951 case (2)
7952# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7953 idx = i + 1 + global_offset_x - index_x
7954# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7955 if (idx < 1 .or. idx > xrows) &
7956# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7957 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
7958# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7959 do f = 1, sys_size - 1
7960# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7961 jump = merge(1, 0, f >= eqn_idx%mom%end)
7962# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7963 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
7964# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7965 end do
7966# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7967 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
7968# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7969 case (3)
7970# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7971 idx = i + 1 + global_offset_x - index_x
7972# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7973 idy = j + 1 + global_offset_y - index_y
7974# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7975 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
7976# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7977 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
7978# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7979 do f = 1, sys_size - 1
7980# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7981 jump = merge(1, 0, f >= eqn_idx%mom%end)
7982# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7983 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
7984# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7985 end do
7986# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7987 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
7988# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7989 end select
7990# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7991 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
7992# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7993 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
7994# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7995 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
7996# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7997 ! cross-stream-position profile (real cross-stream velocity is legitimately
7998# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7999 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
8000# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8001 ! zero out mom%beg's true physical value.
8002# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8003 if (.not. files_loaded) then
8004# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8005 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8006# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8007 do f = 1, max_files
8008# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8009 write (file_num_str, '(I0)') f
8010# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8011 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
8012# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8013 end do
8014# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8015
8016# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8017 ! Common file reading setup
8018# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8019 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8020# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8021 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8022# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8023
8024# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8025 select case (num_dims)
8026# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8027 case (1, 2) ! 1D and 2D cases are similar
8028# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8029 ! Count lines
8030# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8031 line_count = 0
8032# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8033 do
8034# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8035 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8036# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8037 if (ios2 /= 0) exit
8038# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8039 line_count = line_count + 1
8040# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8041 end do
8042# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8043 close (unit2)
8044# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8045
8046# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8047 xrows = line_count
8048# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8049 yrows = 1
8050# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8051 index_x = 0
8052# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8053 if (num_dims == 2) index_x = i
8054# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8055#ifdef MFC_DEBUG
8056# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8057 block
8058# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8059 use iso_fortran_env, only: output_unit
8060# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8061
8062# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8063 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8064# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8065
8066# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8067 call flush (output_unit)
8068# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8069 end block
8070# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8071#endif
8072# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8073 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8074# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8075
8076# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8077
8078# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8079
8080# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8081#if defined(MFC_OpenACC)
8082# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8083!$acc enter data create(x_coords, stored_values)
8084# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8085#elif defined(MFC_OpenMP)
8086# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8087!$omp target enter data map(always,alloc:x_coords, stored_values)
8088# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8089#endif
8090# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8091
8092# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8093 ! Read data from all files
8094# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8095 do f = 1, max_files
8096# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8097 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8098# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8099 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8100# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8101
8102# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8103 do iter = 1, xrows
8104# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8105 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8106# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8107 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8108# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8109 end do
8110# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8111 close (unit)
8112# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8113 end do
8114# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8115
8116# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8117 ! Calculate offsets
8118# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8119 domain_xstart = x_coords(1)
8120# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8121 x_step = x_cc(1) - x_cc(0)
8122# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8123 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
8124# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8125 global_offset_x = nint(abs(delta_x)/x_step)
8126# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8127 case (3) ! 3D case - determine grid structure
8128# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8129 ! Find yRows by counting rows with same x
8130# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8131 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8132# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8133 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8134# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8135
8136# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8137 yrows = 1
8138# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8139 do
8140# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8141 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8142# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8143 if (ios2 /= 0) exit
8144# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8145 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8146# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8147 yrows = yrows + 1
8148# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8149 else
8150# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8151 exit
8152# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8153 end if
8154# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8155 end do
8156# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8157 close (unit2)
8158# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8159
8160# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8161 ! Count total rows
8162# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8163 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8164# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8165 nrows = 0
8166# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8167 do
8168# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8169 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8170# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8171 if (ios2 /= 0) exit
8172# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8173 nrows = nrows + 1
8174# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8175 end do
8176# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8177 close (unit2)
8178# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8179
8180# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8181 xrows = nrows/yrows
8182# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8183#ifdef MFC_DEBUG
8184# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8185 block
8186# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8187 use iso_fortran_env, only: output_unit
8188# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8189
8190# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8191 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8192# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8193
8194# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8195 call flush (output_unit)
8196# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8197 end block
8198# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8199#endif
8200# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8201 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8202# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8203
8204# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8205
8206# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8207
8208# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8209
8210# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8211#if defined(MFC_OpenACC)
8212# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8213!$acc enter data create(x_coords, y_coords, stored_values)
8214# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8215#elif defined(MFC_OpenMP)
8216# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8217!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8218# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8219#endif
8220# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8221 index_x = i
8222# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8223 index_y = j
8224# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8225
8226# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8227 ! Read all files
8228# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8229 do f = 1, max_files
8230# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8231 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8232# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8233 if (ios /= 0) then
8234# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8235 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8236# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8237 cycle
8238# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8239 end if
8240# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8241
8242# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8243 iter = 0
8244# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8245 do iix = 1, xrows
8246# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8247 do iiy = 1, yrows
8248# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8249 iter = iter + 1
8250# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8251 if (f == 1) then
8252# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8253 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8254# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8255 else
8256# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8257 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8258# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8259 end if
8260# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8261 if (ios /= 0) call s_mpi_abort("Error reading data")
8262# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8263 end do
8264# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8265 end do
8266# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8267 close (unit)
8268# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8269 end do
8270# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8271
8272# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8273 ! Calculate offsets
8274# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8275 x_step = x_cc(1) - x_cc(0)
8276# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8277 y_step = y_cc(1) - y_cc(0)
8278# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8279 delta_x = x_cc(index_x) - x_coords(1)
8280# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8281 delta_y = y_cc(index_y) - y_coords(1)
8282# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8283 global_offset_x = nint(abs(delta_x)/x_step)
8284# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8285 global_offset_y = nint(abs(delta_y)/y_step)
8286# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8287 end select
8288# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8289
8290# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8291 files_loaded = .true.
8292# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8293 end if
8294# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8295
8296# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8297 ! Data assignment
8298# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8299 select case (num_dims)
8300# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8301 case (1)
8302# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8303 idx = i + 1 + global_offset_x
8304# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8305 ! idx must land inside the file's row range: this rank's subdomain offset
8306# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8307 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
8308# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8309 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
8310# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8311 if (idx < 1 .or. idx > xrows) &
8312# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8313 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8314# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8315 do f = 1, sys_size
8316# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8317 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8318# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8319 end do
8320# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8321 case (2)
8322# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8323 idx = i + 1 + global_offset_x - index_x
8324# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8325 if (idx < 1 .or. idx > xrows) &
8326# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8327 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8328# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8329 do f = 1, sys_size - 1
8330# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8331 jump = merge(1, 0, f >= eqn_idx%mom%end)
8332# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8333 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8334# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8335 end do
8336# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8337 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8338# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8339 case (3)
8340# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8341 idx = i + 1 + global_offset_x - index_x
8342# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8343 idy = j + 1 + global_offset_y - index_y
8344# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8345 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
8346# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8347 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
8348# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8349 do f = 1, sys_size - 1
8350# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8351 jump = merge(1, 0, f >= eqn_idx%mom%end)
8352# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8353 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8354# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8355 end do
8356# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8357 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8358# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8359 end select
8360# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8361 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
8362# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8363 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
8364# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8365 case (274) ! Full 2D field from external data (no extrusion)
8366# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8367 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
8368# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8369 ! extrusion direction and no zeroed component -- all sys_size variables are read and
8370# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8371 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
8372# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8373 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
8374# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8375 ! global grid exactly -- by construction, since the IC generator derives both the
8376# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8377 ! grid and the file contents from the same computation.
8378# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8379 !
8380# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8381 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
8382# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8383 ! file's own first coordinate and this rank's uniform grid spacing -- following the
8384# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8385 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
8386# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8387 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
8388# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8389 ! returns before allocating it otherwise), so a serial-IO run (the default for
8390# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8391 ! golden-file tests) would index into an unallocated array.
8392# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8393 !
8394# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8395 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
8396# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8397 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
8398# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8399 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
8400# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8401 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
8402# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8403 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
8404# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8405 ! global cell offset) are pinned from f274==1's very first record, before any other
8406# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8407 ! record is read, so every subsequent record -- across all variables -- can be tested
8408# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8409 ! against this rank's range and dropped if it falls outside it.
8410# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8411 x_step274 = x_cc(1) - x_cc(0)
8412# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8413 y_step274 = y_cc(1) - y_cc(0)
8414# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8415
8416# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8417 if (.not. files_loaded274) then
8418# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8419#ifdef MFC_DEBUG
8420# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8421 block
8422# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8423 use iso_fortran_env, only: output_unit
8424# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8425
8426# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8427 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
8428# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8429
8430# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8431 call flush (output_unit)
8432# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8433 end block
8434# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8435#endif
8436# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8437 allocate (stored_values274(0:m, 0:n, sys_size))
8438# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8439
8440# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8441
8442# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8443#if defined(MFC_OpenACC)
8444# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8445!$acc enter data create(stored_values274)
8446# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8447#elif defined(MFC_OpenMP)
8448# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8449!$omp target enter data map(always,alloc:stored_values274)
8450# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8451#endif
8452# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8453 do f274 = 1, sys_size
8454# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8455 write (file_num_str274, '(I0)') f274
8456# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8457 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
8458# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8459 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
8460# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8461 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
8462# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8463 do ix274 = 0, m_glb
8464# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8465 do iy274 = 0, n_glb
8466# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8467 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
8468# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8469 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
8470# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8471 ! Capture the file's own origin and spacing from its first records so we can
8472# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8473 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
8474# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8475 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
8476# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8477 if (f274 == 1) then
8478# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8479 if (ix274 == 0 .and. iy274 == 0) then
8480# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8481 x0_274 = dummy_x274
8482# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8483 y0_274 = dummy_y274
8484# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8485 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
8486# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8487 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
8488# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8489 end if
8490# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8491 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
8492# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8493 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
8494# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8495 end if
8496# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8497 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
8498# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8499 & .and. iy274 - local_iy_beg274 <= n) then
8500# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8501 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
8502# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8503 end if
8504# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8505 end do
8506# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8507 end do
8508# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8509 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
8510# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8511 ! read means it was generated for a larger grid and would be silently misread.
8512# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8513 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
8514# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8515 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
8516# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8517 close (unit274)
8518# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8519 end do
8520# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8521
8522# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8523 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
8524# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8525 ! Check alignment via the integer cell offset of this rank's first cell from the file
8526# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8527 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
8528# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8529 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
8530# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8531 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
8532# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8533 ! the global origin.) The spacing checks below must also hold.
8534# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8535 r_align274 = (x_cc(0) - x0_274)/x_step274
8536# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8537 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
8538# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8539 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
8540# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8541 if (m_glb >= 1) then
8542# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8543 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
8544# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8545 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
8546# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8547 end if
8548# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8549 if (n_glb >= 1) then
8550# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8551 r_align274 = (y_cc(0) - y0_274)/y_step274
8552# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8553 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
8554# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8555 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
8556# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8557 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
8558# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8559 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
8560# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8561 end if
8562# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8563
8564# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8565 files_loaded274 = .true.
8566# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8567 end if
8568# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8569 ! Alignment is verified above (or this rank would already have aborted), so the local
8570# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8571 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
8572# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8573 do f274 = 1, sys_size
8574# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8575 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
8576# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8577 end do
8578# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8579 case (271) ! Premixed Flame Vortices Interaction
8580# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8581 if (.not. files_loaded) then
8582# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8583 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8584# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8585 do f = 1, max_files
8586# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8587 write (file_num_str, '(I0)') f
8588# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8589 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
8590# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8591 end do
8592# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8593
8594# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8595 ! Common file reading setup
8596# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8597 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8598# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8599 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8600# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8601
8602# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8603 select case (num_dims)
8604# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8605 case (1, 2) ! 1D and 2D cases are similar
8606# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8607 ! Count lines
8608# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8609 line_count = 0
8610# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8611 do
8612# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8613 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8614# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8615 if (ios2 /= 0) exit
8616# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8617 line_count = line_count + 1
8618# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8619 end do
8620# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8621 close (unit2)
8622# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8623
8624# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8625 xrows = line_count
8626# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8627 yrows = 1
8628# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8629 index_x = 0
8630# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8631 if (num_dims == 2) index_x = i
8632# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8633#ifdef MFC_DEBUG
8634# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8635 block
8636# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8637 use iso_fortran_env, only: output_unit
8638# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8639
8640# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8641 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8642# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8643
8644# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8645 call flush (output_unit)
8646# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8647 end block
8648# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8649#endif
8650# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8651 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8652# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8653
8654# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8655
8656# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8657
8658# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8659#if defined(MFC_OpenACC)
8660# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8661!$acc enter data create(x_coords, stored_values)
8662# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8663#elif defined(MFC_OpenMP)
8664# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8665!$omp target enter data map(always,alloc:x_coords, stored_values)
8666# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8667#endif
8668# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8669
8670# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8671 ! Read data from all files
8672# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8673 do f = 1, max_files
8674# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8675 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8676# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8677 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8678# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8679
8680# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8681 do iter = 1, xrows
8682# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8683 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8684# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8685 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8686# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8687 end do
8688# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8689 close (unit)
8690# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8691 end do
8692# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8693
8694# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8695 ! Calculate offsets
8696# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8697 domain_xstart = x_coords(1)
8698# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8699 x_step = x_cc(1) - x_cc(0)
8700# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8701 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
8702# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8703 global_offset_x = nint(abs(delta_x)/x_step)
8704# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8705 case (3) ! 3D case - determine grid structure
8706# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8707 ! Find yRows by counting rows with same x
8708# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8709 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8710# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8711 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8712# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8713
8714# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8715 yrows = 1
8716# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8717 do
8718# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8719 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8720# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8721 if (ios2 /= 0) exit
8722# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8723 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8724# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8725 yrows = yrows + 1
8726# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8727 else
8728# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8729 exit
8730# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8731 end if
8732# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8733 end do
8734# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8735 close (unit2)
8736# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8737
8738# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8739 ! Count total rows
8740# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8741 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8742# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8743 nrows = 0
8744# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8745 do
8746# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8747 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8748# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8749 if (ios2 /= 0) exit
8750# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8751 nrows = nrows + 1
8752# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8753 end do
8754# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8755 close (unit2)
8756# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8757
8758# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8759 xrows = nrows/yrows
8760# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8761#ifdef MFC_DEBUG
8762# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8763 block
8764# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8765 use iso_fortran_env, only: output_unit
8766# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8767
8768# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8769 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8770# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8771
8772# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8773 call flush (output_unit)
8774# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8775 end block
8776# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8777#endif
8778# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8779 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8780# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8781
8782# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8783
8784# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8785
8786# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8787
8788# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8789#if defined(MFC_OpenACC)
8790# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8791!$acc enter data create(x_coords, y_coords, stored_values)
8792# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8793#elif defined(MFC_OpenMP)
8794# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8795!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8796# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8797#endif
8798# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8799 index_x = i
8800# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8801 index_y = j
8802# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8803
8804# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8805 ! Read all files
8806# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8807 do f = 1, max_files
8808# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8809 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8810# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8811 if (ios /= 0) then
8812# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8813 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8814# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8815 cycle
8816# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8817 end if
8818# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8819
8820# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8821 iter = 0
8822# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8823 do iix = 1, xrows
8824# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8825 do iiy = 1, yrows
8826# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8827 iter = iter + 1
8828# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8829 if (f == 1) then
8830# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8831 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8832# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8833 else
8834# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8835 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8836# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8837 end if
8838# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8839 if (ios /= 0) call s_mpi_abort("Error reading data")
8840# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8841 end do
8842# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8843 end do
8844# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8845 close (unit)
8846# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8847 end do
8848# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8849
8850# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8851 ! Calculate offsets
8852# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8853 x_step = x_cc(1) - x_cc(0)
8854# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8855 y_step = y_cc(1) - y_cc(0)
8856# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8857 delta_x = x_cc(index_x) - x_coords(1)
8858# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8859 delta_y = y_cc(index_y) - y_coords(1)
8860# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8861 global_offset_x = nint(abs(delta_x)/x_step)
8862# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8863 global_offset_y = nint(abs(delta_y)/y_step)
8864# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8865 end select
8866# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8867
8868# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8869 files_loaded = .true.
8870# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8871 end if
8872# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8873
8874# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8875 ! Data assignment
8876# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8877 select case (num_dims)
8878# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8879 case (1)
8880# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8881 idx = i + 1 + global_offset_x
8882# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8883 ! idx must land inside the file's row range: this rank's subdomain offset
8884# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8885 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
8886# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8887 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
8888# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8889 if (idx < 1 .or. idx > xrows) &
8890# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8891 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8892# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8893 do f = 1, sys_size
8894# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8895 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8896# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8897 end do
8898# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8899 case (2)
8900# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8901 idx = i + 1 + global_offset_x - index_x
8902# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8903 if (idx < 1 .or. idx > xrows) &
8904# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8905 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8906# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8907 do f = 1, sys_size - 1
8908# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8909 jump = merge(1, 0, f >= eqn_idx%mom%end)
8910# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8911 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8912# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8913 end do
8914# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8915 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8916# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8917 case (3)
8918# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8919 idx = i + 1 + global_offset_x - index_x
8920# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8921 idy = j + 1 + global_offset_y - index_y
8922# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8923 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
8924# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8925 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
8926# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8927 do f = 1, sys_size - 1
8928# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8929 jump = merge(1, 0, f >= eqn_idx%mom%end)
8930# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8931 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8932# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8933 end do
8934# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8935 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8936# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8937 end select
8938# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8939 x1c = 0.0027_wp
8940# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8941 y1c = 0.005_wp
8942# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8943 x2c = 0.0027_wp
8944# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8945 y2c = 0.003_wp
8946# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8947 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
8948# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8949 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
8950# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8951 rvortex = 0.0005_wp
8952# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8953 cvortex = 6000.0_wp
8954# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8955
8956# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8957 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
8958# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8959 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
8960# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8961
8962# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8963 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
8964# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8965 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
8966# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8967 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
8968# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8969 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
8970# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8971 case (272) ! Premixed Flame Instability
8972# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8973 if (.not. files_loaded) then
8974# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8975 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8976# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8977 do f = 1, max_files
8978# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8979 write (file_num_str, '(I0)') f
8980# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8981 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
8982# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8983 end do
8984# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8985
8986# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8987 ! Common file reading setup
8988# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8989 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8990# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8991 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8992# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8993
8994# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8995 select case (num_dims)
8996# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8997 case (1, 2) ! 1D and 2D cases are similar
8998# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8999 ! Count lines
9000# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9001 line_count = 0
9002# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9003 do
9004# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9005 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9006# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9007 if (ios2 /= 0) exit
9008# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9009 line_count = line_count + 1
9010# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9011 end do
9012# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9013 close (unit2)
9014# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9015
9016# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9017 xrows = line_count
9018# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9019 yrows = 1
9020# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9021 index_x = 0
9022# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9023 if (num_dims == 2) index_x = i
9024# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9025#ifdef MFC_DEBUG
9026# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9027 block
9028# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9029 use iso_fortran_env, only: output_unit
9030# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9031
9032# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9033 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9034# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9035
9036# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9037 call flush (output_unit)
9038# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9039 end block
9040# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9041#endif
9042# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9043 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9044# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9045
9046# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9047
9048# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9049
9050# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9051#if defined(MFC_OpenACC)
9052# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9053!$acc enter data create(x_coords, stored_values)
9054# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9055#elif defined(MFC_OpenMP)
9056# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9057!$omp target enter data map(always,alloc:x_coords, stored_values)
9058# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9059#endif
9060# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9061
9062# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9063 ! Read data from all files
9064# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9065 do f = 1, max_files
9066# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9067 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9068# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9069 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9070# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9071
9072# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9073 do iter = 1, xrows
9074# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9075 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9076# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9077 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
9078# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9079 end do
9080# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9081 close (unit)
9082# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9083 end do
9084# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9085
9086# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9087 ! Calculate offsets
9088# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9089 domain_xstart = x_coords(1)
9090# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9091 x_step = x_cc(1) - x_cc(0)
9092# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9093 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
9094# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9095 global_offset_x = nint(abs(delta_x)/x_step)
9096# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9097 case (3) ! 3D case - determine grid structure
9098# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9099 ! Find yRows by counting rows with same x
9100# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9101 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9102# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9103 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9104# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9105
9106# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9107 yrows = 1
9108# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9109 do
9110# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9111 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9112# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9113 if (ios2 /= 0) exit
9114# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9115 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
9116# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9117 yrows = yrows + 1
9118# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9119 else
9120# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9121 exit
9122# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9123 end if
9124# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9125 end do
9126# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9127 close (unit2)
9128# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9129
9130# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9131 ! Count total rows
9132# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9133 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9134# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9135 nrows = 0
9136# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9137 do
9138# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9139 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9140# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9141 if (ios2 /= 0) exit
9142# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9143 nrows = nrows + 1
9144# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9145 end do
9146# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9147 close (unit2)
9148# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9149
9150# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9151 xrows = nrows/yrows
9152# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9153#ifdef MFC_DEBUG
9154# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9155 block
9156# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9157 use iso_fortran_env, only: output_unit
9158# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9159
9160# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9161 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9162# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9163
9164# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9165 call flush (output_unit)
9166# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9167 end block
9168# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9169#endif
9170# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9171 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9172# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9173
9174# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9175
9176# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9177
9178# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9179
9180# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9181#if defined(MFC_OpenACC)
9182# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9183!$acc enter data create(x_coords, y_coords, stored_values)
9184# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9185#elif defined(MFC_OpenMP)
9186# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9187!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9188# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9189#endif
9190# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9191 index_x = i
9192# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9193 index_y = j
9194# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9195
9196# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9197 ! Read all files
9198# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9199 do f = 1, max_files
9200# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9201 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9202# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9203 if (ios /= 0) then
9204# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9205 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9206# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9207 cycle
9208# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9209 end if
9210# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9211
9212# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9213 iter = 0
9214# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9215 do iix = 1, xrows
9216# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9217 do iiy = 1, yrows
9218# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9219 iter = iter + 1
9220# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9221 if (f == 1) then
9222# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9223 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9224# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9225 else
9226# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9227 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9228# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9229 end if
9230# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9231 if (ios /= 0) call s_mpi_abort("Error reading data")
9232# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9233 end do
9234# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9235 end do
9236# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9237 close (unit)
9238# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9239 end do
9240# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9241
9242# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9243 ! Calculate offsets
9244# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9245 x_step = x_cc(1) - x_cc(0)
9246# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9247 y_step = y_cc(1) - y_cc(0)
9248# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9249 delta_x = x_cc(index_x) - x_coords(1)
9250# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9251 delta_y = y_cc(index_y) - y_coords(1)
9252# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9253 global_offset_x = nint(abs(delta_x)/x_step)
9254# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9255 global_offset_y = nint(abs(delta_y)/y_step)
9256# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9257 end select
9258# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9259
9260# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9261 files_loaded = .true.
9262# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9263 end if
9264# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9265
9266# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9267 ! Data assignment
9268# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9269 select case (num_dims)
9270# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9271 case (1)
9272# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9273 idx = i + 1 + global_offset_x
9274# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9275 ! idx must land inside the file's row range: this rank's subdomain offset
9276# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9277 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
9278# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9279 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
9280# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9281 if (idx < 1 .or. idx > xrows) &
9282# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9283 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9284# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9285 do f = 1, sys_size
9286# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9287 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9288# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9289 end do
9290# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9291 case (2)
9292# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9293 idx = i + 1 + global_offset_x - index_x
9294# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9295 if (idx < 1 .or. idx > xrows) &
9296# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9297 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9298# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9299 do f = 1, sys_size - 1
9300# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9301 jump = merge(1, 0, f >= eqn_idx%mom%end)
9302# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9303 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9304# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9305 end do
9306# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9307 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9308# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9309 case (3)
9310# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9311 idx = i + 1 + global_offset_x - index_x
9312# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9313 idy = j + 1 + global_offset_y - index_y
9314# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9315 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
9316# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9317 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
9318# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9319 do f = 1, sys_size - 1
9320# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9321 jump = merge(1, 0, f >= eqn_idx%mom%end)
9322# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9323 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9324# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9325 end do
9326# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9327 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9328# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9329 end select
9330# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9331
9332# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9333 y_center = y0_ref
9334# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9335 y_dist = y_cc(j) - y_center
9336# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9337 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
9338# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9339 front_shift = a_param*sin(wave_phase)
9340# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9341
9342# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9343 x_mapped = x_cc(i) - front_shift
9344# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9345
9346# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9347 if (x_mapped <= x_coords(1)) then
9348# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9349 do v = 1, sys_size - 1
9350# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9351 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
9352# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9353 end do
9354# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9355 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9356# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9357 else if (x_mapped >= x_coords(xrows)) then
9358# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9359 do v = 1, sys_size - 1
9360# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9361 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
9362# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9363 end do
9364# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9365 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9366# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9367 else
9368# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9369 idx_lo = 1; idx_hi = xrows
9370# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9371 do while (idx_hi - idx_lo > 1)
9372# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9373 idx_mid = (idx_lo + idx_hi)/2
9374# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9375 if (x_coords(idx_mid) <= x_mapped) then
9376# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9377 idx_lo = idx_mid
9378# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9379 else
9380# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9381 idx_hi = idx_mid
9382# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9383 end if
9384# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9385 end do
9386# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9387
9388# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9389 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
9390# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9391
9392# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9393 do v = 1, sys_size - 1
9394# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9395 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
9396# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9397 & v) + interp_wt*stored_values(idx_hi, 1, v)
9398# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9399 end do
9400# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9401 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9402# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9403 end if
9404# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9405 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
9406# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9407 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
9408# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9409 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
9410# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9411 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
9412# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9413 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
9414# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9415 & - y_domain%beg))
9416# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9417 if (x_cc(i) > d) then
9418# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9419 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
9420# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9421 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
9422# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9423 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
9424# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9425 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
9426# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9427 do v = eqn_idx%species%beg, eqn_idx%species%end
9428# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9429 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
9430# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9431 end do
9432# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9433 end if
9434# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9435 case (280) ! Isentropic vortex
9436# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9437 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
9438# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9439 ! geometry 2
9440# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9441 if (patch_id == 1) then
9442# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9443 q_prim_vf(eqn_idx%E)%sf(i, j, &
9444# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9445 & 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) &
9446# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9447 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9448# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9449 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9450# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9451 & 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) &
9452# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9453 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9454# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9455 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9456# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9457 & 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) &
9458# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9459 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9460# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9461 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9462# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9463 & 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) &
9464# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9465 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9466# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9467 end if
9468# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9469 case (281) ! Acoustic pulse
9470# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9471 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
9472# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9473 ! geometry 2
9474# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9475 if (patch_id == 2) then
9476# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9477 q_prim_vf(eqn_idx%E)%sf(i, j, &
9478# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9479 & 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))
9480# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9481 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9482# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9483 & 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))
9484# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9485 end if
9486# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9487 case (282) ! Zero-circulation vortex
9488# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9489 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
9490# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9491 ! geometry 2
9492# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9493 if (patch_id == 2) then
9494# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9495 q_prim_vf(eqn_idx%E)%sf(i, j, &
9496# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9497 & 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))
9498# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9499 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9500# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9501 & 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))
9502# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9503 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9504# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9505 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9506# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9507 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9508# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9509 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9510# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9511 end if
9512# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9513 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
9514# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9515 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
9516# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9517 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
9518# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9519 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
9520# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9521 ! patch_icpp(patch_id)%epsilon; defaults to 5.
9522# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9523 if (patch_id == 1) then
9524# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9525 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
9526# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9527 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
9528# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9529 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
9530# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9531 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
9532# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9533 do igq = 1, 3
9534# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9535 do jgq = 1, 3
9536# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9537 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
9538# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9539 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
9540# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9541 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
9542# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9543 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))
9544# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9545 wq = gauss_w(igq)*gauss_w(jgq)
9546# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9547 rhoq = t_facq**1.4_wp
9548# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9549 pq = t_facq**2.4_wp
9550# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9551 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9552# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9553 & - r2q)
9554# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9555 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
9556# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9557 & - r2q)
9558# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9559 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
9560# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9561 rho_avg = rho_avg + wq*rhoq
9562# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9563 rhou_avg = rhou_avg + wq*(rhoq*uq)
9564# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9565 rhov_avg = rhov_avg + wq*(rhoq*vq)
9566# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9567 e_avg = e_avg + wq*eq
9568# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9569 end do
9570# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9571 end do
9572# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9573 rho_avg = rho_avg*0.25_wp
9574# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9575 rhou_avg = rhou_avg*0.25_wp
9576# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9577 rhov_avg = rhov_avg*0.25_wp
9578# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9579 e_avg = e_avg*0.25_wp
9580# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9581 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
9582# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9583 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
9584# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9585 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
9586# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9587 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
9588# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9589 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
9590# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9591 end if
9592# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9593 case (291) ! Isothermal Flat Plate
9594# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9595 t_inf = 1125.0_wp
9596# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9597 t_wall = 600.0_wp
9598# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9599 p_atm = 101325.0_wp
9600# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9601
9602# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9603 ! Boundary/Shear Layer thicknesses
9604# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9605 delta_th = 0.0003_wp ! Thermal BL thickness
9606# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9607 delta_shear = 8e-3_wp ! Velocity BL thickness
9608# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9609
9610# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9611 u_max = 50.0_wp ! Freestream Velocity (m/s)
9612# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9613
9614# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9615 mw_n2 = 28.0134e-3_wp
9616# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9617 mw_o2 = 31.999e-3_wp
9618# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9619 y_n2 = 0.767_wp
9620# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9621 y_o2 = 0.233_wp
9622# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9623 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
9624# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9625 bottom_blend_u = tanh(y_cc(j)/delta_shear)
9626# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9627 bottom_blend_t = tanh(y_cc(j)/delta_th)
9628# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9629 u_mean = u_max*bottom_blend_u
9630# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9631 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
9632# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9633 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
9634# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9635 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
9636# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9637 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9638# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9639 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
9640# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9641 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
9642# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9643 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
9644# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9645 case default
9646# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9647 if (proc_rank == 0) then
9648# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9649 call s_int_to_str(patch_id, istr)
9650# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9651 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
9652# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9653 end if
9654# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9655 end select
9656 end if
9657
9658 ! Updating the patch identities bookkeeping variable
9659 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9660
9661 q_prim_vf(eqn_idx%alf)%sf(i, j, &
9662 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
9663 end if
9664 end do
9665 end do
9666 if (allocated(stored_values)) then
9667# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668#ifdef MFC_DEBUG
9669# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 block
9671# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 use iso_fortran_env, only: output_unit
9673# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674
9675# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(stored_values)'
9677# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678
9679# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 call flush (output_unit)
9681# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682 end block
9683# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684#endif
9685# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686
9687# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688#if defined(MFC_OpenACC)
9689# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690!$acc exit data delete(stored_values)
9691# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692#elif defined(MFC_OpenMP)
9693# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694!$omp target exit data map(release:stored_values)
9695# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696#endif
9697# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9698 deallocate (stored_values)
9699# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9700#ifdef MFC_DEBUG
9701# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9702 block
9703# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9704 use iso_fortran_env, only: output_unit
9705# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9706
9707# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9708 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(x_coords)'
9709# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9710
9711# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9712 call flush (output_unit)
9713# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9714 end block
9715# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9716#endif
9717# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9718
9719# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9720#if defined(MFC_OpenACC)
9721# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9722!$acc exit data delete(x_coords)
9723# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9724#elif defined(MFC_OpenMP)
9725# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9726!$omp target exit data map(release:x_coords)
9727# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9728#endif
9729# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9730 deallocate (x_coords)
9731# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9732 end if
9733# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9734
9735# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9736 if (allocated(y_coords)) then
9737# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9738#ifdef MFC_DEBUG
9739# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9740 block
9741# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9742 use iso_fortran_env, only: output_unit
9743# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9744
9745# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9746 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(y_coords)'
9747# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9748
9749# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9750 call flush (output_unit)
9751# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9752 end block
9753# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9754#endif
9755# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9756
9757# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9758#if defined(MFC_OpenACC)
9759# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9760!$acc exit data delete(y_coords)
9761# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9762#elif defined(MFC_OpenMP)
9763# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9764!$omp target exit data map(release:y_coords)
9765# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9766#endif
9767# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9768 deallocate (y_coords)
9769# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9770 end if
9771# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9772
9773# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9774 files_loaded = .false.
9775# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9776
9777# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9778 if (allocated(stored_values274)) then
9779# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9780#ifdef MFC_DEBUG
9781# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9782 block
9783# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9784 use iso_fortran_env, only: output_unit
9785# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9786
9787# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9788 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(stored_values274)'
9789# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9790
9791# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9792 call flush (output_unit)
9793# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9794 end block
9795# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9796#endif
9797# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9798
9799# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9800#if defined(MFC_OpenACC)
9801# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9802!$acc exit data delete(stored_values274)
9803# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9804#elif defined(MFC_OpenMP)
9805# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9806!$omp target exit data map(release:stored_values274)
9807# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9808#endif
9809# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9810 deallocate (stored_values274)
9811# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9812 end if
9813# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9814
9815# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9816 files_loaded274 = .false.
9817
9818 end subroutine s_icpp_varcircle
9819
9820 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
9821 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
9822
9823 ! Patch identifier
9824 integer, intent(in) :: patch_id
9825
9826#ifdef MFC_MIXED_PRECISION
9827 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9828#else
9829 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
9830#endif
9831 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9832
9833 ! Generic loop iterators
9834 integer :: i, j, k
9835 real(wp) :: radius, myr, thickness
9836
9837 integer :: xRows, yRows, nRows, iix, iiy, max_files
9838# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9839 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
9840# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9841 real(wp) :: x_step, y_step
9842# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9843 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9844# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9845 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
9846# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9847 real(wp) :: delta_x, delta_y
9848# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9849 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
9850# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9851 real(wp), allocatable :: stored_values(:,:,:)
9852# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9853 real(wp), allocatable :: x_coords(:), y_coords(:)
9854# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9855 logical :: files_loaded = .false.
9856# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9857 real(wp) :: domain_xstart
9858# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9859 character(len=20) :: file_num_str !< For storing the file number as a string
9860# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9861 integer :: ios
9862# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9863 integer :: ios2
9864# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9865
9866# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9867 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
9868# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9869 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
9870# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9871 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
9872# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9873 ! y_coords/files_loaded above.
9874# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9875 real(wp), allocatable, dimension(:,:,:) :: stored_values274
9876# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9877 logical :: files_loaded274 = .false.
9878# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9879 integer :: f274, ix274, iy274, unit274, ios274
9880# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9881 integer :: local_ix_beg274, local_iy_beg274
9882# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9883 character(len=300) :: fname274
9884# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9885 character(len=20) :: file_num_str274
9886# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9887 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
9888# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9889 real(wp) :: file_dx274, file_dy274, r_align274
9890 ! Place any declaration of intermediate variables here
9891# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9892 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9893# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9894 real(wp) :: eps
9895# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9896
9897# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9898 ! IGR Jets Arrays to stor position and radii of jets from input file
9899# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9900 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9901# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9902 ! Variables to describe initial condition of jet
9903# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9904 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9905# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9906 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
9907# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9908 real(wp), dimension(0:n,0:p) :: rcut_arr
9909# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9910 integer :: l, q, s !< Iterators for reading input files
9911# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9912 integer :: start, end !< Ints to keep track of position in file
9913# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9914 character(len=100000) :: line ! String to store line in file
9915# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9916 character(len=25) :: value !< String to store value in line
9917# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9918 integer :: NJet !< Number of jets
9919# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9920 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
9921# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9922 logical :: file_exist ! Flag to check if file exists
9923# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9924
9925# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9926 eps = 1e-9_wp
9927# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9928
9929# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9930 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
9931# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9932 eps_smooth = 3._wp
9933# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9934 inquire (file="njet.txt", exist=file_exist)
9935# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9936 if (file_exist) then
9937# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9938 open (unit=10, file="njet.txt", status="old", action="read")
9939# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9940 read (10, *) njet
9941# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9942 close (10)
9943# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9944 else
9945# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9946 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
9947# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9948 end if
9949# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9950
9951# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9952#ifdef MFC_DEBUG
9953# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9954 block
9955# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9956 use iso_fortran_env, only: output_unit
9957# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9958
9959# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9960 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
9961# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9962
9963# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9964 call flush (output_unit)
9965# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9966 end block
9967# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9968#endif
9969# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9970 allocate (y_th_arr(0:njet - 1))
9971# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9972
9973# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9974
9975# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9976#if defined(MFC_OpenACC)
9977# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9978!$acc enter data create(y_th_arr)
9979# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9980#elif defined(MFC_OpenMP)
9981# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9982!$omp target enter data map(always,alloc:y_th_arr)
9983# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9984#endif
9985# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9986#ifdef MFC_DEBUG
9987# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9988 block
9989# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9990 use iso_fortran_env, only: output_unit
9991# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9992
9993# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9994 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
9995# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9996
9997# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9998 call flush (output_unit)
9999# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10000 end block
10001# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10002#endif
10003# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10004 allocate (z_th_arr(0:njet - 1))
10005# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10006
10007# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10008
10009# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10010#if defined(MFC_OpenACC)
10011# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10012!$acc enter data create(z_th_arr)
10013# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10014#elif defined(MFC_OpenMP)
10015# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10016!$omp target enter data map(always,alloc:z_th_arr)
10017# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10018#endif
10019# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10020#ifdef MFC_DEBUG
10021# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10022 block
10023# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10024 use iso_fortran_env, only: output_unit
10025# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10026
10027# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10028 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
10029# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10030
10031# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10032 call flush (output_unit)
10033# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10034 end block
10035# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10036#endif
10037# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10038 allocate (r_th_arr(0:njet - 1))
10039# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10040
10041# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10042
10043# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10044#if defined(MFC_OpenACC)
10045# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10046!$acc enter data create(r_th_arr)
10047# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10048#elif defined(MFC_OpenMP)
10049# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10050!$omp target enter data map(always,alloc:r_th_arr)
10051# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10052#endif
10053# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10054
10055# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10056 inquire (file="jets.csv", exist=file_exist)
10057# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10058 if (file_exist) then
10059# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10060 open (unit=10, file="jets.csv", status="old", action="read")
10061# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10062 do q = 0, njet - 1
10063# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10064 read (10, '(A)') line ! Read a full line as a string
10065# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10066 start = 1
10067# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10068
10069# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10070 do l = 0, 2
10071# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10072 end = index(line(start:), ',') ! Find the next comma
10073# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10074 if (end == 0) then
10075# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10076 value = trim(adjustl(line(start:))) ! Last value in the line
10077# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10078 else
10079# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10080 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
10081# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10082 start = start + end ! Move to next value
10083# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10084 end if
10085# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10086 if (l == 0) then
10087# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10088 read (value, *) y_th_arr(q) ! Convert string to numeric value
10089# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10090 else if (l == 1) then
10091# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10092 read (value, *) z_th_arr(q)
10093# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10094 else
10095# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10096 read (value, *) r_th_arr(q)
10097# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10098 end if
10099# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10100 end do
10101# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10102 end do
10103# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10104 close (10)
10105# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10106
10107# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10108 do q = 0, p
10109# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10110 do l = 0, n
10111# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10112 rcut = 0._wp
10113# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10114 do s = 0, njet - 1
10115# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10116 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
10117# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10118 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
10119# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10120 end do
10121# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10122 rcut_arr(l, q) = rcut
10123# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10124 end do
10125# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10126 end do
10127# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10128 else
10129# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10130 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
10131# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10132 end if
10133# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10134 end if
10135# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10136
10137# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10138 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
10139# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10140#ifdef MFC_DEBUG
10141# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10142 block
10143# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10144 use iso_fortran_env, only: output_unit
10145# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10146
10147# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10148 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
10149# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10150
10151# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10152 call flush (output_unit)
10153# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10154 end block
10155# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10156#endif
10157# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10158 allocate (ih(0:n_glb, 0:p_glb))
10159# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10160
10161# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10162
10163# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10164#if defined(MFC_OpenACC)
10165# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10166!$acc enter data create(ih)
10167# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10168#elif defined(MFC_OpenMP)
10169# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10170!$omp target enter data map(always,alloc:ih)
10171# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10172#endif
10173# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10174
10175# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10176 if (interface_file == '.') then
10177# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10178 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
10179# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10180 else
10181# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10182 inquire (file=trim(interface_file), exist=file_exist)
10183# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10184 if (file_exist) then
10185# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10186 open (unit=10, file=trim(interface_file), status="old", action="read")
10187# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10188 do i = 0, n_glb
10189# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10190 read (10, '(A)') line ! Read a full line as a string
10191# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10192 start = 1
10193# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10194
10195# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10196 do j = 0, p_glb
10197# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10198 end = index(line(start:), ',') ! Find the next comma
10199# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10200 if (end == 0) then
10201# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10202 value = trim(adjustl(line(start:))) ! Last value in the line
10203# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10204 else
10205# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10206 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
10207# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10208 start = start + end ! Move to next value
10209# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10210 end if
10211# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10212 read (value, *) ih(i, j) ! Convert string to numeric value
10213# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10214 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
10215# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10216 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
10217# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10218 end do
10219# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10220 end do
10221# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10222 close (10)
10223# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10224 else
10225# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10226 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
10227# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10228 end if
10229# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10230 end if
10231# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10232 end if
10233# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10234
10235# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10236 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
10237# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10238#ifdef MFC_DEBUG
10239# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10240 block
10241# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10242 use iso_fortran_env, only: output_unit
10243# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10244
10245# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10246 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
10247# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10248
10249# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10250 call flush (output_unit)
10251# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10252 end block
10253# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10254#endif
10255# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10256 allocate (ih(0:n_glb, 0:0))
10257# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10258
10259# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10260
10261# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10262#if defined(MFC_OpenACC)
10263# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10264!$acc enter data create(ih)
10265# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10266#elif defined(MFC_OpenMP)
10267# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10268!$omp target enter data map(always,alloc:ih)
10269# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10270#endif
10271# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10272 if (interface_file == '.') then
10273# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10274 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
10275# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10276 else
10277# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10278 inquire (file=trim(interface_file), exist=file_exist)
10279# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10280 if (file_exist) then
10281# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10282 open (unit=10, file=trim(interface_file), status="old", action="read")
10283# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10284 do i = 0, n_glb
10285# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10286 read (10, '(A)') line ! Read a full line as a string
10287# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10288 value = trim(line)
10289# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10290 read (value, *) ih(i, 0) ! Convert string to numeric value
10291# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10292 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
10293# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10294 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
10295# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10296 end do
10297# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10298 close (10)
10299# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10300 else
10301# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10302 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
10303# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10304 end if
10305# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10306 end if
10307# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10308 end if
10309
10310 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
10311 x_centroid = patch_icpp(patch_id)%x_centroid
10312 y_centroid = patch_icpp(patch_id)%y_centroid
10313 z_centroid = patch_icpp(patch_id)%z_centroid
10314 length_z = patch_icpp(patch_id)%length_z
10315 radius = patch_icpp(patch_id)%radius
10316 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
10317 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
10318 thickness = patch_icpp(patch_id)%epsilon
10319
10320 ! Initialize eta=1; modified if smoothing is enabled
10321 eta = 1._wp
10322
10323 ! write for all z
10324
10325 ! Assign patch vars if cell is covered and patch has write permission
10326 do k = 0, p
10327 do j = 0, n
10328 do i = 0, m
10329 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
10330
10331 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
10332 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
10333 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
10334
10335
10336 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10337 select case (patch_icpp(patch_id)%hcid)
10338# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10339 case (300) ! Rayleigh-Taylor instability
10340# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10341 rhoh = 3._wp
10342# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10343 rhol = 1._wp
10344# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10345 pref = 1.e5_wp
10346# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10347 pint = pref
10348# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10349 h = 0.7_wp
10350# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10351 lam = 0.2_wp
10352# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10353 wl = 2._wp*pi/lam
10354# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10355 amp = 0.025_wp/wl
10356# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10357
10358# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10359 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
10360# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10361
10362# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10363 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10364# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10365
10366# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10367 if (alph < eps) alph = eps
10368# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10369 if (alph > 1._wp - eps) alph = 1._wp - eps
10370# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10371
10372# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10373 if (y_cc(j) > inth) then
10374# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10375 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10376# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10377 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10378# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10379 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
10380# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10381 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
10382# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10383 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10384# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10385 else
10386# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10387 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10388# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10389 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10390# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10391 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
10392# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10393 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
10394# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10395 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10396# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10397 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
10398# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10399 end if
10400# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10401 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
10402# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10403 h = 0.0_wp
10404# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10405 lam = 1.0_wp
10406# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10407 amp = patch_icpp(patch_id)%a(2)
10408# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10409 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
10410# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10411 if (x_cc(i) > inth) then
10412# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10413 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
10414# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10415 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
10416# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10417 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
10418# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10419 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
10420# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10421 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
10422# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10423 end if
10424# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10425 case (302) ! 3D Jet with IGR
10426# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10427 ux_th = 10*sqrt(1.4*0.4)
10428# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10429 ux_am = 0.0*sqrt(1.4)
10430# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10431 p_th = 2.0_wp
10432# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10433 p_am = 1.0_wp
10434# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10435 rho_th = 1._wp
10436# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10437 rho_am = 1._wp
10438# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10439 y_th = 0.0_wp
10440# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10441 z_th = 0.0_wp
10442# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10443 r_th = 1._wp
10444# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10445 eps_smooth = 1._wp
10446# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10447 eps = 1e-6
10448# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10449
10450# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10451 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
10452# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10453 rcut = f_cut_on(r - r_th, eps_smooth)
10454# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10455 xcut = f_cut_on(x_cc(i), eps_smooth)
10456# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10457
10458# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10459 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
10460# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10461 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
10462# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10463 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
10464# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10465
10466# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10467 if (num_fluids == 1) then
10468# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10469 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
10470# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10471 else
10472# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10473 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
10474# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10475 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
10476# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10477 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))
10478# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10479 end if
10480# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10481
10482# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10483 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
10484# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10485 case (303) ! 3D Multijet
10486# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10487 eps_smooth = 3.0_wp
10488# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10489 ux_th = 10*sqrt(1.4*0.4)
10490# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10491 ux_am = 2.5*sqrt(1.4*0.4)
10492# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10493 p_th = 0.8_wp
10494# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10495 p_am = 0.4_wp
10496# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10497 rho_th = 1._wp
10498# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10499 rho_am = 1._wp
10500# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10501 eps = 1e-6
10502# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10503
10504# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10505 rcut = rcut_arr(j, k)
10506# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10507 xcut = f_cut_on(x_cc(i), eps_smooth)
10508# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10509
10510# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10511 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
10512# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10513 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
10514# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10515 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
10516# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10517
10518# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10519 if (num_fluids == 1) then
10520# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10521 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
10522# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10523 else
10524# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10525 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
10526# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10527 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
10528# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10529 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))
10530# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10531 end if
10532# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10533
10534# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10535 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
10536# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10537 case (304) ! 3D Interface from file cartesian
10538# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10539 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
10540# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10541
10542# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10543 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10544# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10545 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10546# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10547
10548# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10549 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
10550# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10551 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
10552# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10553
10554# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10555 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
10556# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10557 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
10558# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10559
10560# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10561 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
10562# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10563 case (305) ! 3D Interface from file axisymmetric
10564# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10565 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
10566# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10567
10568# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10569 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10570# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10571 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10572# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10573
10574# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10575 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
10576# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10577 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
10578# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10579
10580# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10581 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
10582# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10583 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
10584# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10585
10586# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10587 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
10588# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10589 case (370) ! 3D extrusion of 2D profile from external data
10590# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10591 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
10592# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10593 if (.not. files_loaded) then
10594# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10595 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
10596# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10597 do f = 1, max_files
10598# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10599 write (file_num_str, '(I0)') f
10600# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10601 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
10602# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10603 end do
10604# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10605
10606# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10607 ! Common file reading setup
10608# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10609 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10610# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10611 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
10612# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10613
10614# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10615 select case (num_dims)
10616# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10617 case (1, 2) ! 1D and 2D cases are similar
10618# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10619 ! Count lines
10620# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10621 line_count = 0
10622# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10623 do
10624# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10625 read (unit2, *, iostat=ios2) dummy_x, dummy_y
10626# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10627 if (ios2 /= 0) exit
10628# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10629 line_count = line_count + 1
10630# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10631 end do
10632# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10633 close (unit2)
10634# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10635
10636# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10637 xrows = line_count
10638# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10639 yrows = 1
10640# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10641 index_x = 0
10642# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10643 if (num_dims == 2) index_x = i
10644# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10645#ifdef MFC_DEBUG
10646# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10647 block
10648# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10649 use iso_fortran_env, only: output_unit
10650# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10651
10652# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10653 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
10654# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10655
10656# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10657 call flush (output_unit)
10658# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10659 end block
10660# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10661#endif
10662# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10663 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10664# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10665
10666# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10667
10668# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10669
10670# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10671#if defined(MFC_OpenACC)
10672# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10673!$acc enter data create(x_coords, stored_values)
10674# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10675#elif defined(MFC_OpenMP)
10676# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10677!$omp target enter data map(always,alloc:x_coords, stored_values)
10678# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10679#endif
10680# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10681
10682# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10683 ! Read data from all files
10684# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10685 do f = 1, max_files
10686# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10687 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10688# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10689 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10690# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10691
10692# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10693 do iter = 1, xrows
10694# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10695 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10696# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10697 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
10698# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10699 end do
10700# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10701 close (unit)
10702# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10703 end do
10704# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10705
10706# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10707 ! Calculate offsets
10708# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10709 domain_xstart = x_coords(1)
10710# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10711 x_step = x_cc(1) - x_cc(0)
10712# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10713 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
10714# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10715 global_offset_x = nint(abs(delta_x)/x_step)
10716# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10717 case (3) ! 3D case - determine grid structure
10718# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10719 ! Find yRows by counting rows with same x
10720# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10721 read (unit2, *, iostat=ios2) x0, y0, dummy_z
10722# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10723 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
10724# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10725
10726# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10727 yrows = 1
10728# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10729 do
10730# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10731 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10732# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10733 if (ios2 /= 0) exit
10734# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10735 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
10736# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10737 yrows = yrows + 1
10738# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10739 else
10740# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10741 exit
10742# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10743 end if
10744# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10745 end do
10746# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10747 close (unit2)
10748# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10749
10750# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10751 ! Count total rows
10752# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10753 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10754# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10755 nrows = 0
10756# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10757 do
10758# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10759 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
10760# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10761 if (ios2 /= 0) exit
10762# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10763 nrows = nrows + 1
10764# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10765 end do
10766# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10767 close (unit2)
10768# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10769
10770# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10771 xrows = nrows/yrows
10772# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10773#ifdef MFC_DEBUG
10774# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10775 block
10776# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10777 use iso_fortran_env, only: output_unit
10778# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10779
10780# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10781 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
10782# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10783
10784# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10785 call flush (output_unit)
10786# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10787 end block
10788# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10789#endif
10790# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10791 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
10792# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10793
10794# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10795
10796# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10797
10798# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10799
10800# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10801#if defined(MFC_OpenACC)
10802# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10803!$acc enter data create(x_coords, y_coords, stored_values)
10804# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10805#elif defined(MFC_OpenMP)
10806# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10807!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
10808# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10809#endif
10810# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10811 index_x = i
10812# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10813 index_y = j
10814# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10815
10816# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10817 ! Read all files
10818# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10819 do f = 1, max_files
10820# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10821 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10822# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10823 if (ios /= 0) then
10824# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10825 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
10826# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10827 cycle
10828# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10829 end if
10830# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10831
10832# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10833 iter = 0
10834# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10835 do iix = 1, xrows
10836# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10837 do iiy = 1, yrows
10838# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10839 iter = iter + 1
10840# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10841 if (f == 1) then
10842# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10843 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
10844# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10845 else
10846# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10847 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
10848# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10849 end if
10850# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10851 if (ios /= 0) call s_mpi_abort("Error reading data")
10852# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10853 end do
10854# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10855 end do
10856# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10857 close (unit)
10858# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10859 end do
10860# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10861
10862# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10863 ! Calculate offsets
10864# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10865 x_step = x_cc(1) - x_cc(0)
10866# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10867 y_step = y_cc(1) - y_cc(0)
10868# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10869 delta_x = x_cc(index_x) - x_coords(1)
10870# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10871 delta_y = y_cc(index_y) - y_coords(1)
10872# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10873 global_offset_x = nint(abs(delta_x)/x_step)
10874# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10875 global_offset_y = nint(abs(delta_y)/y_step)
10876# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10877 end select
10878# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10879
10880# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10881 files_loaded = .true.
10882# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10883 end if
10884# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10885
10886# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10887 ! Data assignment
10888# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10889 select case (num_dims)
10890# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10891 case (1)
10892# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10893 idx = i + 1 + global_offset_x
10894# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10895 ! idx must land inside the file's row range: this rank's subdomain offset
10896# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10897 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
10898# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10899 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
10900# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10901 if (idx < 1 .or. idx > xrows) &
10902# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10903 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
10904# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10905 do f = 1, sys_size
10906# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10907 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10908# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10909 end do
10910# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10911 case (2)
10912# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10913 idx = i + 1 + global_offset_x - index_x
10914# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10915 if (idx < 1 .or. idx > xrows) &
10916# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10917 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
10918# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10919 do f = 1, sys_size - 1
10920# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10921 jump = merge(1, 0, f >= eqn_idx%mom%end)
10922# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10923 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10924# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10925 end do
10926# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10927 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
10928# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10929 case (3)
10930# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10931 idx = i + 1 + global_offset_x - index_x
10932# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10933 idy = j + 1 + global_offset_y - index_y
10934# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10935 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
10936# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10937 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
10938# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10939 do f = 1, sys_size - 1
10940# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10941 jump = merge(1, 0, f >= eqn_idx%mom%end)
10942# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10943 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10944# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10945 end do
10946# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10947 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
10948# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10949 end select
10950# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10951 case (380) ! Taylor-Green vortex
10952# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10953 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
10954# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10955 ! geometry 9
10956# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10957 mach = 0.1
10958# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10959 if (patch_id == 1) then
10960# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10961 q_prim_vf(eqn_idx%E)%sf(i, j, &
10962# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10963 & 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)
10964# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10965 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)
10966# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10967 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)
10968# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10969 end if
10970# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10971 case default
10972# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10973 call s_int_to_str(patch_id, istr)
10974# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10975 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10976# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10977 end select
10978 end if
10979
10980 ! Updating the patch identities bookkeeping variable
10981 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
10982
10983 q_prim_vf(eqn_idx%alf)%sf(i, j, &
10984 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
10985 end if
10986 end do
10987 end do
10988 end do
10989 if (allocated(stored_values)) then
10990# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10991#ifdef MFC_DEBUG
10992# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10993 block
10994# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10995 use iso_fortran_env, only: output_unit
10996# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10997
10998# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10999 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(stored_values)'
11000# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11001
11002# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11003 call flush (output_unit)
11004# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11005 end block
11006# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11007#endif
11008# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11009
11010# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11011#if defined(MFC_OpenACC)
11012# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11013!$acc exit data delete(stored_values)
11014# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11015#elif defined(MFC_OpenMP)
11016# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11017!$omp target exit data map(release:stored_values)
11018# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11019#endif
11020# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11021 deallocate (stored_values)
11022# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11023#ifdef MFC_DEBUG
11024# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11025 block
11026# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11027 use iso_fortran_env, only: output_unit
11028# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11029
11030# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11031 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(x_coords)'
11032# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11033
11034# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11035 call flush (output_unit)
11036# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11037 end block
11038# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11039#endif
11040# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11041
11042# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11043#if defined(MFC_OpenACC)
11044# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11045!$acc exit data delete(x_coords)
11046# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11047#elif defined(MFC_OpenMP)
11048# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11049!$omp target exit data map(release:x_coords)
11050# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11051#endif
11052# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11053 deallocate (x_coords)
11054# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11055 end if
11056# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11057
11058# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11059 if (allocated(y_coords)) then
11060# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11061#ifdef MFC_DEBUG
11062# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11063 block
11064# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11065 use iso_fortran_env, only: output_unit
11066# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11067
11068# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11069 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(y_coords)'
11070# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11071
11072# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11073 call flush (output_unit)
11074# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11075 end block
11076# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11077#endif
11078# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11079
11080# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11081#if defined(MFC_OpenACC)
11082# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11083!$acc exit data delete(y_coords)
11084# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11085#elif defined(MFC_OpenMP)
11086# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11087!$omp target exit data map(release:y_coords)
11088# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11089#endif
11090# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11091 deallocate (y_coords)
11092# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11093 end if
11094# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11095
11096# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11097 files_loaded = .false.
11098# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11099
11100# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11101 if (allocated(stored_values274)) then
11102# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11103#ifdef MFC_DEBUG
11104# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11105 block
11106# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11107 use iso_fortran_env, only: output_unit
11108# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11109
11110# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11111 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(stored_values274)'
11112# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11113
11114# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11115 call flush (output_unit)
11116# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11117 end block
11118# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11119#endif
11120# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11121
11122# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11123#if defined(MFC_OpenACC)
11124# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11125!$acc exit data delete(stored_values274)
11126# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11127#elif defined(MFC_OpenMP)
11128# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11129!$omp target exit data map(release:stored_values274)
11130# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11131#endif
11132# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11133 deallocate (stored_values274)
11134# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11135 end if
11136# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11137
11138# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11139 files_loaded274 = .false.
11140
11141 end subroutine s_icpp_3dvarcircle
11142
11143 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
11144 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
11145 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
11146
11147 integer, intent(in) :: patch_id
11148
11149#ifdef MFC_MIXED_PRECISION
11150 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11151#else
11152 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
11153#endif
11154 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11155 integer :: i, j, k !< Generic loop operators
11156 real(wp) :: a, b
11157
11158 integer :: xRows, yRows, nRows, iix, iiy, max_files
11159# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11160 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
11161# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11162 real(wp) :: x_step, y_step
11163# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11164 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11165# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11166 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
11167# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11168 real(wp) :: delta_x, delta_y
11169# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11170 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
11171# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11172 real(wp), allocatable :: stored_values(:,:,:)
11173# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11174 real(wp), allocatable :: x_coords(:), y_coords(:)
11175# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11176 logical :: files_loaded = .false.
11177# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11178 real(wp) :: domain_xstart
11179# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11180 character(len=20) :: file_num_str !< For storing the file number as a string
11181# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11182 integer :: ios
11183# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11184 integer :: ios2
11185# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11186
11187# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11188 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
11189# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11190 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
11191# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11192 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
11193# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11194 ! y_coords/files_loaded above.
11195# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11196 real(wp), allocatable, dimension(:,:,:) :: stored_values274
11197# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11198 logical :: files_loaded274 = .false.
11199# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11200 integer :: f274, ix274, iy274, unit274, ios274
11201# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11202 integer :: local_ix_beg274, local_iy_beg274
11203# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11204 character(len=300) :: fname274
11205# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11206 character(len=20) :: file_num_str274
11207# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11208 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
11209# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11210 real(wp) :: file_dx274, file_dy274, r_align274
11211 ! Place any declaration of intermediate variables here
11212# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11213 real(wp) :: eps, eps_mhd, C_mhd
11214# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11215 real(wp) :: r, rmax, gam, umax, p0
11216# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11217 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
11218# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11219 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
11220# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11221 real(wp) :: r0, alpha, r2
11222# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11223 real(wp) :: sinA, cosA
11224# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11225 real(wp) :: r_sq
11226# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11227
11228# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11229 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
11230# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11231 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
11232# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11233 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
11234# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11235 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
11236# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11237 integer :: igq, jgq
11238# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11239
11240# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11241 ! # 291 - Shear/Thermal Layer Case
11242# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11243 real(wp) :: delta_shear, u_max, u_mean
11244# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11245 real(wp) :: T_wall, T_inf, P_atm, T_loc
11246# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11247 real(wp) :: delta_th, R_mix
11248# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11249 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
11250# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11251 real(wp) :: bottom_blend_u, bottom_blend_T
11252# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11253
11254# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11255 ! # 207
11256# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11257 real(wp) :: sigma, gauss1, gauss2
11258# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11259
11260# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11261 ! # 208
11262# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11263 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
11264# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11265 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
11266# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11267 integer :: v, idx_lo, idx_hi, idx_mid
11268# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11269 real(wp), parameter :: Ly_param = 0.00775735_wp
11270# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11271 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
11272# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11273 integer, parameter :: Nwaves = 6
11274# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11275 real(wp), parameter :: y0_ref = 0.0_wp
11276# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11277
11278# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11279 eps = 1.e-9_wp
11280
11281 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
11282 x_centroid = patch_icpp(patch_id)%x_centroid
11283 y_centroid = patch_icpp(patch_id)%y_centroid
11284 a = patch_icpp(patch_id)%radii(1)
11285 b = patch_icpp(patch_id)%radii(2)
11286 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
11287 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
11288
11289 ! Initialize eta=1; modified if smoothing is enabled
11290 eta = 1._wp
11291
11292 ! Assign patch vars if cell is covered and patch has write permission
11293 do j = 0, n
11294 do i = 0, m
11295 if (patch_icpp(patch_id)%smoothen) then
11296 eta = tanh(smooth_coeff/min(dx_min, &
11297 & dy_min)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
11298 & + 0.5_wp
11299 end if
11300
11301 if ((f_is_inside_ellipse(x_cc(i) - x_centroid, y_cc(j) - y_centroid, [2._wp*a, 2._wp*b, &
11302 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
11303 & 0) == smooth_patch_id) then
11304 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
11305
11306
11307 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11308 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
11309# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11310 case (200) ! Two-fluid cubic interface
11311# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11312 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
11313# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11314 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
11315# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11316 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
11317# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11318 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
11319# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11320 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
11321# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11322 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
11323# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11324 end if
11325# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11326 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
11327# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11328 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
11329# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11330 rmax = 0.2_wp
11331# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11332
11333# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11334 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
11335# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11336 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
11337# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11338 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
11339# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11340
11341# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11342 if (r < rmax) then
11343# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11344 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
11345# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11346 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
11347# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11348 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
11349# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11350 else if (r < 2*rmax) then
11351# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11352 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
11353# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11354 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
11355# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11356 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)))
11357# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11358 else
11359# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11360 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
11361# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11362 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
11363# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11364 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
11365# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11366 end if
11367# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11368 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
11369# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11370 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
11371# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11372 rmax = 0.2_wp
11373# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11374
11375# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11376 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
11377# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11378 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
11379# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11380 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
11381# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11382
11383# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11384 if (r < rmax) then
11385# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11386 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
11387# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11388 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
11389# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11390 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
11391# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11392 else if (r < 2*rmax) then
11393# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11394 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
11395# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11396 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
11397# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11398 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)))
11399# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11400 else
11401# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11402 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
11403# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11404 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
11405# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11406 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
11407# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11408 end if
11409# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11410
11411# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11412 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
11413# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11414 case (204) ! Rayleigh-Taylor instability
11415# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11416 rhoh = 3._wp
11417# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11418 rhol = 1._wp
11419# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11420 pref = 1.e5_wp
11421# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11422 pint = pref
11423# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11424 h = 0.7_wp
11425# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11426 lam = 0.2_wp
11427# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11428 wl = 2._wp*pi/lam
11429# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11430 amp = 0.05_wp/wl
11431# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11432
11433# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11434 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
11435# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11436
11437# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11438 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
11439# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11440
11441# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11442 if (alph < eps) alph = eps
11443# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11444 if (alph > 1._wp - eps) alph = 1._wp - eps
11445# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11446
11447# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11448 if (y_cc(j) > inth) then
11449# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11450 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
11451# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11452 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
11453# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11454 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
11455# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11456 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
11457# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11458 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
11459# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11460 else
11461# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11462 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
11463# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11464 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
11465# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11466 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
11467# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11468 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
11469# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11470 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
11471# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11472 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
11473# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11474 end if
11475# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11476 case (205) ! 2D lung wave interaction problem
11477# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11478 h = 0.0_wp ! non dim origin y
11479# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11480 lam = 1.0_wp ! non dim lambda
11481# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11482 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
11483# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11484
11485# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11486 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
11487# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11488
11489# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11490 if (y_cc(j) > inth) then
11491# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11492 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
11493# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11494 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
11495# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11496 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
11497# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11498 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
11499# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11500 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
11501# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11502 end if
11503# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11504 case (206) ! 2D lung wave interaction problem - horizontal domain
11505# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11506 h = 0.0_wp ! non dim origin y
11507# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11508 lam = 1.0_wp ! non dim lambda
11509# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11510 amp = patch_icpp(patch_id)%a(2)
11511# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11512
11513# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11514 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
11515# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11516
11517# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11518 if (x_cc(i) > intl) then ! this is the liquid
11519# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11520 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
11521# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11522 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
11523# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11524 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
11525# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11526 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
11527# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11528 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
11529# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11530 end if
11531# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11532 case (207) ! Kelvin Helmholtz Instability
11533# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11534 sigma = 0.05_wp/sqrt(2.0_wp)
11535# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11536 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
11537# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11538 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
11539# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11540 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)
11541# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11542 case (208) ! Richtmeyer Meshkov Instability
11543# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11544 lam = 1.0_wp
11545# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11546 eps = 1.0e-6_wp
11547# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11548 ei = 5.0_wp
11549# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11550 ! Smoothening function to smooth out sharp discontinuity in the interface
11551# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11552 if (x_cc(i) <= 0.7_wp*lam) then
11553# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11554 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
11555# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11556 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
11557# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11558 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
11559# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11560 alpha_sf6 = 1.0_wp - alpha_air
11561# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11562 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
11563# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11564 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
11565# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11566 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
11567# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11568 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
11569# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11570 end if
11571# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11572 case (250) ! MHD Orszag-Tang vortex
11573# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11574 ! 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),
11575# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11576 ! sin(4*pi*x)/sqrt(4*pi), 0)
11577# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11578
11579# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11580 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
11581# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11582 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
11583# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11584
11585# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11586 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
11587# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11588 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
11589# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11590 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
11591# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11592 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
11593# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11594 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
11595# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11596 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
11597# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11598 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
11599# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11600 ! Linear interpolation between r=0.08 and r=1.0
11601# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11602 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
11603# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11604 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
11605# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11606 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
11607# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11608 else
11609# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11610 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
11611# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11612 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
11613# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11614 end if
11615# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11616
11617# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11618 ! case 252 is for the 2D MHD Rotor problem
11619# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11620 case (252) ! 2D MHD Rotor Problem
11621# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11622 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
11623# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11624 !
11625# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11626 ! 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
11627# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11628 ! velocity w=20, giving v_tan=2 at r=0.1
11629# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11630
11631# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11632 ! Calculate distance squared from the center
11633# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11634 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
11635# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11636
11637# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11638 ! inner radius of 0.1
11639# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11640 if (r_sq <= 0.1**2) then
11641# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11642 ! -- Inside the rotor -- Set density uniformly to 10
11643# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11644 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
11645# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11646
11647# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11648 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
11649# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11650 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
11651# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11652 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
11653# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11654
11655# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11656 ! taper width of 0.015
11657# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11658 else if (r_sq <= 0.115**2) then
11659# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11660 ! linearly smooth the function between r = 0.1 and 0.115
11661# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11662 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
11663# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11664
11665# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11666 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)
11667# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11668 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)
11669# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11670 end if
11671# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11672 case (253) ! MHD Smooth Magnetic Vortex
11673# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11674 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
11675# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11676 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
11677# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678
11679# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680 ! velocity
11681# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682 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))
11683# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 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))
11685# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686
11687# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688 ! magnetic field
11689# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690 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)
11691# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692 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)
11693# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694
11695# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696 ! pressure
11697# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698 q_prim_vf(eqn_idx%E)%sf(i, j, &
11699# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700 & 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)
11701# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702 case (260) ! Gaussian Divergence Pulse
11703# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
11705# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
11707# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708 ! initialized to zero everywhere.
11709# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710
11711# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712 eps_mhd = patch_icpp(patch_id)%a(2)
11713# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714 sigma = patch_icpp(patch_id)%a(3)
11715# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
11717# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718
11719# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720 ! B-field
11721# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
11723# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11724 case (261) ! Blob
11725# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11726 r0 = 1._wp/sqrt(8._wp)
11727# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11728 r2 = x_cc(i)**2 + y_cc(j)**2
11729# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11730 r = sqrt(r2)
11731# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11732 alpha = r/r0
11733# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11734 if (alpha < 1) then
11735# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11736 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)
11737# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11738 ! 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)
11739# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11740 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
11741# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11742 ! 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
11743# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11744 end if
11745# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11746 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
11747# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11748 ! rotate by \alpha = atan(2)
11749# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750 alpha = atan(2._wp)
11751# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752 cosa = cos(alpha)
11753# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754 sina = sin(alpha)
11755# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756 ! projection along shock normal
11757# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758 r = x_cc(i)*cosa + y_cc(j)*sina
11759# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760
11761# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762 if (r <= 0.5_wp) then
11763# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
11765# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11767# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
11769# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
11771# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
11773# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 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
11775# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 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
11777# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11778 else
11779# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11780 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
11781# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11782 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
11783# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11784 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
11785# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11786 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
11787# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11788 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
11789# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11790 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
11791# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11792 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
11793# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11794 end if
11795# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11796 ! v^z and B^z remain zero by default
11797# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11798 case (270) ! 2D extrusion of 1D profile from external data
11799# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11800 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
11801# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11802 if (.not. files_loaded) then
11803# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11804 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11805# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11806 do f = 1, max_files
11807# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 write (file_num_str, '(I0)') f
11809# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
11811# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812 end do
11813# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814
11815# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816 ! Common file reading setup
11817# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11819# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11821# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822
11823# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 select case (num_dims)
11825# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 case (1, 2) ! 1D and 2D cases are similar
11827# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 ! Count lines
11829# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830 line_count = 0
11831# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 do
11833# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11835# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836 if (ios2 /= 0) exit
11837# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 line_count = line_count + 1
11839# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840 end do
11841# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842 close (unit2)
11843# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844
11845# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 xrows = line_count
11847# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848 yrows = 1
11849# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850 index_x = 0
11851# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852 if (num_dims == 2) index_x = i
11853# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854#ifdef MFC_DEBUG
11855# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856 block
11857# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 use iso_fortran_env, only: output_unit
11859# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860
11861# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11863# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864
11865# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 call flush (output_unit)
11867# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868 end block
11869# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870#endif
11871# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11873# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874
11875# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876
11877# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878
11879# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880#if defined(MFC_OpenACC)
11881# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882!$acc enter data create(x_coords, stored_values)
11883# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884#elif defined(MFC_OpenMP)
11885# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886!$omp target enter data map(always,alloc:x_coords, stored_values)
11887# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888#endif
11889# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890
11891# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892 ! Read data from all files
11893# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 do f = 1, max_files
11895# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11897# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11899# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900
11901# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902 do iter = 1, xrows
11903# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11905# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11907# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908 end do
11909# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910 close (unit)
11911# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912 end do
11913# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914
11915# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916 ! Calculate offsets
11917# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918 domain_xstart = x_coords(1)
11919# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 x_step = x_cc(1) - x_cc(0)
11921# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
11923# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 global_offset_x = nint(abs(delta_x)/x_step)
11925# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926 case (3) ! 3D case - determine grid structure
11927# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928 ! Find yRows by counting rows with same x
11929# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11931# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11933# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934
11935# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 yrows = 1
11937# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 do
11939# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11941# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942 if (ios2 /= 0) exit
11943# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11945# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 yrows = yrows + 1
11947# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948 else
11949# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950 exit
11951# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952 end if
11953# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954 end do
11955# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956 close (unit2)
11957# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958
11959# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960 ! Count total rows
11961# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11963# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964 nrows = 0
11965# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 do
11967# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11969# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 if (ios2 /= 0) exit
11971# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972 nrows = nrows + 1
11973# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 end do
11975# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 close (unit2)
11977# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978
11979# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980 xrows = nrows/yrows
11981# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982#ifdef MFC_DEBUG
11983# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11984 block
11985# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11986 use iso_fortran_env, only: output_unit
11987# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11988
11989# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11990 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11991# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11992
11993# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11994 call flush (output_unit)
11995# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11996 end block
11997# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11998#endif
11999# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12000 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12001# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12002
12003# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12004
12005# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12006
12007# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12008
12009# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12010#if defined(MFC_OpenACC)
12011# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12012!$acc enter data create(x_coords, y_coords, stored_values)
12013# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12014#elif defined(MFC_OpenMP)
12015# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12016!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12017# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12018#endif
12019# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12020 index_x = i
12021# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12022 index_y = j
12023# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12024
12025# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12026 ! Read all files
12027# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12028 do f = 1, max_files
12029# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12030 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12031# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12032 if (ios /= 0) then
12033# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12034 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12035# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12036 cycle
12037# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12038 end if
12039# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12040
12041# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12042 iter = 0
12043# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12044 do iix = 1, xrows
12045# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12046 do iiy = 1, yrows
12047# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12048 iter = iter + 1
12049# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12050 if (f == 1) then
12051# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12052 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12053# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12054 else
12055# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12056 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12057# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12058 end if
12059# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12060 if (ios /= 0) call s_mpi_abort("Error reading data")
12061# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12062 end do
12063# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12064 end do
12065# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12066 close (unit)
12067# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12068 end do
12069# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12070
12071# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12072 ! Calculate offsets
12073# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12074 x_step = x_cc(1) - x_cc(0)
12075# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12076 y_step = y_cc(1) - y_cc(0)
12077# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12078 delta_x = x_cc(index_x) - x_coords(1)
12079# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12080 delta_y = y_cc(index_y) - y_coords(1)
12081# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12082 global_offset_x = nint(abs(delta_x)/x_step)
12083# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12084 global_offset_y = nint(abs(delta_y)/y_step)
12085# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12086 end select
12087# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12088
12089# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12090 files_loaded = .true.
12091# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12092 end if
12093# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12094
12095# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12096 ! Data assignment
12097# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12098 select case (num_dims)
12099# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12100 case (1)
12101# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12102 idx = i + 1 + global_offset_x
12103# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12104 ! idx must land inside the file's row range: this rank's subdomain offset
12105# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12106 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
12107# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12108 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
12109# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12110 if (idx < 1 .or. idx > xrows) &
12111# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12112 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
12113# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12114 do f = 1, sys_size
12115# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12116 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12117# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12118 end do
12119# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12120 case (2)
12121# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12122 idx = i + 1 + global_offset_x - index_x
12123# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12124 if (idx < 1 .or. idx > xrows) &
12125# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12126 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
12127# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12128 do f = 1, sys_size - 1
12129# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12130 jump = merge(1, 0, f >= eqn_idx%mom%end)
12131# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12132 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12133# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12134 end do
12135# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12136 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
12137# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12138 case (3)
12139# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12140 idx = i + 1 + global_offset_x - index_x
12141# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12142 idy = j + 1 + global_offset_y - index_y
12143# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12144 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
12145# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12146 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
12147# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12148 do f = 1, sys_size - 1
12149# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12150 jump = merge(1, 0, f >= eqn_idx%mom%end)
12151# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12152 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12153# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12154 end do
12155# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12156 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
12157# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12158 end select
12159# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12160 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
12161# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12162 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
12163# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12164 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
12165# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12166 ! cross-stream-position profile (real cross-stream velocity is legitimately
12167# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12168 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
12169# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12170 ! zero out mom%beg's true physical value.
12171# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12172 if (.not. files_loaded) then
12173# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12174 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12175# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12176 do f = 1, max_files
12177# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12178 write (file_num_str, '(I0)') f
12179# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12180 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
12181# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12182 end do
12183# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12184
12185# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12186 ! Common file reading setup
12187# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12188 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12189# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12190 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12191# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12192
12193# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12194 select case (num_dims)
12195# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12196 case (1, 2) ! 1D and 2D cases are similar
12197# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12198 ! Count lines
12199# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12200 line_count = 0
12201# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12202 do
12203# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12204 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12205# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12206 if (ios2 /= 0) exit
12207# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12208 line_count = line_count + 1
12209# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12210 end do
12211# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12212 close (unit2)
12213# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12214
12215# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12216 xrows = line_count
12217# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12218 yrows = 1
12219# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12220 index_x = 0
12221# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12222 if (num_dims == 2) index_x = i
12223# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12224#ifdef MFC_DEBUG
12225# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12226 block
12227# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12228 use iso_fortran_env, only: output_unit
12229# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12230
12231# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12232 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12233# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12234
12235# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12236 call flush (output_unit)
12237# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12238 end block
12239# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12240#endif
12241# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12242 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12243# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12244
12245# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12246
12247# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12248
12249# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12250#if defined(MFC_OpenACC)
12251# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12252!$acc enter data create(x_coords, stored_values)
12253# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12254#elif defined(MFC_OpenMP)
12255# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12256!$omp target enter data map(always,alloc:x_coords, stored_values)
12257# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12258#endif
12259# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12260
12261# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 ! Read data from all files
12263# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12264 do f = 1, max_files
12265# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12266 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12267# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12268 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12269# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12270
12271# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12272 do iter = 1, xrows
12273# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12274 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12275# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12276 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
12277# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12278 end do
12279# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12280 close (unit)
12281# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12282 end do
12283# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12284
12285# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12286 ! Calculate offsets
12287# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12288 domain_xstart = x_coords(1)
12289# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12290 x_step = x_cc(1) - x_cc(0)
12291# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12292 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
12293# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12294 global_offset_x = nint(abs(delta_x)/x_step)
12295# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12296 case (3) ! 3D case - determine grid structure
12297# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12298 ! Find yRows by counting rows with same x
12299# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12300 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12301# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12302 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12303# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12304
12305# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12306 yrows = 1
12307# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12308 do
12309# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12310 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12311# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12312 if (ios2 /= 0) exit
12313# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12314 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
12315# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12316 yrows = yrows + 1
12317# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12318 else
12319# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12320 exit
12321# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12322 end if
12323# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12324 end do
12325# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12326 close (unit2)
12327# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12328
12329# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12330 ! Count total rows
12331# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12332 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12333# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12334 nrows = 0
12335# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12336 do
12337# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12338 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12339# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12340 if (ios2 /= 0) exit
12341# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12342 nrows = nrows + 1
12343# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12344 end do
12345# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12346 close (unit2)
12347# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12348
12349# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12350 xrows = nrows/yrows
12351# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12352#ifdef MFC_DEBUG
12353# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12354 block
12355# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12356 use iso_fortran_env, only: output_unit
12357# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12358
12359# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12360 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12361# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12362
12363# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12364 call flush (output_unit)
12365# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12366 end block
12367# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12368#endif
12369# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12370 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12371# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12372
12373# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12374
12375# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12376
12377# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12378
12379# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12380#if defined(MFC_OpenACC)
12381# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12382!$acc enter data create(x_coords, y_coords, stored_values)
12383# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12384#elif defined(MFC_OpenMP)
12385# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12386!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12387# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12388#endif
12389# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12390 index_x = i
12391# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12392 index_y = j
12393# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12394
12395# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12396 ! Read all files
12397# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12398 do f = 1, max_files
12399# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12400 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12401# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12402 if (ios /= 0) then
12403# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12404 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12405# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12406 cycle
12407# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12408 end if
12409# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12410
12411# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12412 iter = 0
12413# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12414 do iix = 1, xrows
12415# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12416 do iiy = 1, yrows
12417# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12418 iter = iter + 1
12419# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12420 if (f == 1) then
12421# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12422 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12423# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12424 else
12425# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12426 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12427# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12428 end if
12429# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12430 if (ios /= 0) call s_mpi_abort("Error reading data")
12431# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12432 end do
12433# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12434 end do
12435# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12436 close (unit)
12437# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12438 end do
12439# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12440
12441# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12442 ! Calculate offsets
12443# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12444 x_step = x_cc(1) - x_cc(0)
12445# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12446 y_step = y_cc(1) - y_cc(0)
12447# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12448 delta_x = x_cc(index_x) - x_coords(1)
12449# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12450 delta_y = y_cc(index_y) - y_coords(1)
12451# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12452 global_offset_x = nint(abs(delta_x)/x_step)
12453# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12454 global_offset_y = nint(abs(delta_y)/y_step)
12455# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12456 end select
12457# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12458
12459# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12460 files_loaded = .true.
12461# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12462 end if
12463# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12464
12465# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12466 ! Data assignment
12467# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12468 select case (num_dims)
12469# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12470 case (1)
12471# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12472 idx = i + 1 + global_offset_x
12473# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12474 ! idx must land inside the file's row range: this rank's subdomain offset
12475# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12476 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
12477# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12478 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
12479# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12480 if (idx < 1 .or. idx > xrows) &
12481# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12482 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
12483# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12484 do f = 1, sys_size
12485# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12486 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12487# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12488 end do
12489# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12490 case (2)
12491# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12492 idx = i + 1 + global_offset_x - index_x
12493# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12494 if (idx < 1 .or. idx > xrows) &
12495# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12496 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
12497# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12498 do f = 1, sys_size - 1
12499# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12500 jump = merge(1, 0, f >= eqn_idx%mom%end)
12501# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12502 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12503# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12504 end do
12505# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12506 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
12507# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12508 case (3)
12509# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12510 idx = i + 1 + global_offset_x - index_x
12511# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12512 idy = j + 1 + global_offset_y - index_y
12513# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12514 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
12515# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12516 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
12517# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12518 do f = 1, sys_size - 1
12519# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12520 jump = merge(1, 0, f >= eqn_idx%mom%end)
12521# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12522 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
12523# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12524 end do
12525# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12526 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
12527# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12528 end select
12529# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12530 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
12531# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12532 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
12533# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12534 case (274) ! Full 2D field from external data (no extrusion)
12535# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12536 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
12537# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12538 ! extrusion direction and no zeroed component -- all sys_size variables are read and
12539# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12540 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
12541# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12542 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
12543# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12544 ! global grid exactly -- by construction, since the IC generator derives both the
12545# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12546 ! grid and the file contents from the same computation.
12547# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 !
12549# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
12551# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12552 ! file's own first coordinate and this rank's uniform grid spacing -- following the
12553# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12554 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
12555# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12556 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
12557# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12558 ! returns before allocating it otherwise), so a serial-IO run (the default for
12559# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12560 ! golden-file tests) would index into an unallocated array.
12561# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12562 !
12563# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12564 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
12565# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12566 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
12567# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12568 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
12569# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12570 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
12571# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12572 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
12573# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12574 ! global cell offset) are pinned from f274==1's very first record, before any other
12575# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12576 ! record is read, so every subsequent record -- across all variables -- can be tested
12577# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12578 ! against this rank's range and dropped if it falls outside it.
12579# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12580 x_step274 = x_cc(1) - x_cc(0)
12581# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12582 y_step274 = y_cc(1) - y_cc(0)
12583# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12584
12585# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12586 if (.not. files_loaded274) then
12587# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12588#ifdef MFC_DEBUG
12589# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12590 block
12591# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12592 use iso_fortran_env, only: output_unit
12593# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12594
12595# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12596 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
12597# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12598
12599# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12600 call flush (output_unit)
12601# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12602 end block
12603# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12604#endif
12605# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12606 allocate (stored_values274(0:m, 0:n, sys_size))
12607# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12608
12609# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12610
12611# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12612#if defined(MFC_OpenACC)
12613# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12614!$acc enter data create(stored_values274)
12615# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12616#elif defined(MFC_OpenMP)
12617# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12618!$omp target enter data map(always,alloc:stored_values274)
12619# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12620#endif
12621# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12622 do f274 = 1, sys_size
12623# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12624 write (file_num_str274, '(I0)') f274
12625# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12626 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
12627# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12628 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
12629# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12630 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
12631# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12632 do ix274 = 0, m_glb
12633# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12634 do iy274 = 0, n_glb
12635# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12636 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
12637# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12638 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
12639# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12640 ! Capture the file's own origin and spacing from its first records so we can
12641# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12642 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
12643# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12644 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
12645# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12646 if (f274 == 1) then
12647# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12648 if (ix274 == 0 .and. iy274 == 0) then
12649# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12650 x0_274 = dummy_x274
12651# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12652 y0_274 = dummy_y274
12653# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12654 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
12655# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12656 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
12657# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12658 end if
12659# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12660 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
12661# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12662 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
12663# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12664 end if
12665# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12666 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
12667# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12668 & .and. iy274 - local_iy_beg274 <= n) then
12669# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12670 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
12671# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12672 end if
12673# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12674 end do
12675# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12676 end do
12677# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12678 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
12679# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12680 ! read means it was generated for a larger grid and would be silently misread.
12681# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12682 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
12683# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12684 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
12685# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12686 close (unit274)
12687# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12688 end do
12689# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12690
12691# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12692 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
12693# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12694 ! Check alignment via the integer cell offset of this rank's first cell from the file
12695# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12696 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
12697# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12698 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
12699# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12700 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
12701# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12702 ! the global origin.) The spacing checks below must also hold.
12703# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12704 r_align274 = (x_cc(0) - x0_274)/x_step274
12705# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12706 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
12707# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12708 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
12709# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12710 if (m_glb >= 1) then
12711# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12712 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
12713# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12714 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
12715# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12716 end if
12717# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 if (n_glb >= 1) then
12719# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 r_align274 = (y_cc(0) - y0_274)/y_step274
12721# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
12723# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
12725# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
12727# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
12729# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 end if
12731# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732
12733# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734 files_loaded274 = .true.
12735# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736 end if
12737# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738 ! Alignment is verified above (or this rank would already have aborted), so the local
12739# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
12741# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742 do f274 = 1, sys_size
12743# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
12745# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746 end do
12747# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748 case (271) ! Premixed Flame Vortices Interaction
12749# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750 if (.not. files_loaded) then
12751# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12753# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754 do f = 1, max_files
12755# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 write (file_num_str, '(I0)') f
12757# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
12759# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760 end do
12761# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762
12763# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764 ! Common file reading setup
12765# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12767# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12769# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770
12771# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772 select case (num_dims)
12773# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774 case (1, 2) ! 1D and 2D cases are similar
12775# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776 ! Count lines
12777# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778 line_count = 0
12779# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780 do
12781# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12783# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 if (ios2 /= 0) exit
12785# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786 line_count = line_count + 1
12787# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 end do
12789# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790 close (unit2)
12791# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792
12793# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794 xrows = line_count
12795# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 yrows = 1
12797# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 index_x = 0
12799# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800 if (num_dims == 2) index_x = i
12801# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802#ifdef MFC_DEBUG
12803# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804 block
12805# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 use iso_fortran_env, only: output_unit
12807# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808
12809# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12811# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812
12813# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 call flush (output_unit)
12815# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816 end block
12817# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818#endif
12819# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12821# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822
12823# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824
12825# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826
12827# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828#if defined(MFC_OpenACC)
12829# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830!$acc enter data create(x_coords, stored_values)
12831# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832#elif defined(MFC_OpenMP)
12833# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834!$omp target enter data map(always,alloc:x_coords, stored_values)
12835# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836#endif
12837# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838
12839# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 ! Read data from all files
12841# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842 do f = 1, max_files
12843# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12845# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12847# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848
12849# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850 do iter = 1, xrows
12851# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12853# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
12855# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856 end do
12857# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858 close (unit)
12859# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860 end do
12861# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862
12863# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864 ! Calculate offsets
12865# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 domain_xstart = x_coords(1)
12867# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868 x_step = x_cc(1) - x_cc(0)
12869# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
12871# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872 global_offset_x = nint(abs(delta_x)/x_step)
12873# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874 case (3) ! 3D case - determine grid structure
12875# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876 ! Find yRows by counting rows with same x
12877# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12879# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12881# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882
12883# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884 yrows = 1
12885# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886 do
12887# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12889# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890 if (ios2 /= 0) exit
12891# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
12893# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894 yrows = yrows + 1
12895# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896 else
12897# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898 exit
12899# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900 end if
12901# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902 end do
12903# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904 close (unit2)
12905# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906
12907# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908 ! Count total rows
12909# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12911# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912 nrows = 0
12913# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 do
12915# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12917# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918 if (ios2 /= 0) exit
12919# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 nrows = nrows + 1
12921# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 end do
12923# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 close (unit2)
12925# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926
12927# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 xrows = nrows/yrows
12929# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930#ifdef MFC_DEBUG
12931# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932 block
12933# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12934 use iso_fortran_env, only: output_unit
12935# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936
12937# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12939# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940
12941# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 call flush (output_unit)
12943# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 end block
12945# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946#endif
12947# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12949# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950
12951# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952
12953# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954
12955# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956
12957# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958#if defined(MFC_OpenACC)
12959# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960!$acc enter data create(x_coords, y_coords, stored_values)
12961# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962#elif defined(MFC_OpenMP)
12963# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12965# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966#endif
12967# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 index_x = i
12969# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970 index_y = j
12971# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972
12973# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974 ! Read all files
12975# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976 do f = 1, max_files
12977# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12979# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980 if (ios /= 0) then
12981# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12983# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984 cycle
12985# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986 end if
12987# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988
12989# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990 iter = 0
12991# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992 do iix = 1, xrows
12993# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994 do iiy = 1, yrows
12995# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996 iter = iter + 1
12997# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998 if (f == 1) then
12999# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13001# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002 else
13003# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13005# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006 end if
13007# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008 if (ios /= 0) call s_mpi_abort("Error reading data")
13009# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 end do
13011# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012 end do
13013# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 close (unit)
13015# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016 end do
13017# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018
13019# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020 ! Calculate offsets
13021# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 x_step = x_cc(1) - x_cc(0)
13023# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 y_step = y_cc(1) - y_cc(0)
13025# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 delta_x = x_cc(index_x) - x_coords(1)
13027# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 delta_y = y_cc(index_y) - y_coords(1)
13029# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030 global_offset_x = nint(abs(delta_x)/x_step)
13031# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032 global_offset_y = nint(abs(delta_y)/y_step)
13033# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034 end select
13035# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036
13037# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 files_loaded = .true.
13039# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040 end if
13041# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042
13043# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044 ! Data assignment
13045# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13046 select case (num_dims)
13047# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13048 case (1)
13049# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13050 idx = i + 1 + global_offset_x
13051# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13052 ! idx must land inside the file's row range: this rank's subdomain offset
13053# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13054 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
13055# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13056 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
13057# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13058 if (idx < 1 .or. idx > xrows) &
13059# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13060 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13061# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13062 do f = 1, sys_size
13063# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13064 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13065# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13066 end do
13067# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13068 case (2)
13069# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13070 idx = i + 1 + global_offset_x - index_x
13071# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13072 if (idx < 1 .or. idx > xrows) &
13073# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13074 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13075# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13076 do f = 1, sys_size - 1
13077# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13078 jump = merge(1, 0, f >= eqn_idx%mom%end)
13079# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13080 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13081# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13082 end do
13083# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13084 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13085# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13086 case (3)
13087# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13088 idx = i + 1 + global_offset_x - index_x
13089# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13090 idy = j + 1 + global_offset_y - index_y
13091# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13092 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
13093# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13094 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
13095# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13096 do f = 1, sys_size - 1
13097# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13098 jump = merge(1, 0, f >= eqn_idx%mom%end)
13099# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13100 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13101# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13102 end do
13103# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13104 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13105# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13106 end select
13107# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13108 x1c = 0.0027_wp
13109# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13110 y1c = 0.005_wp
13111# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13112 x2c = 0.0027_wp
13113# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13114 y2c = 0.003_wp
13115# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13116 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
13117# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13118 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
13119# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13120 rvortex = 0.0005_wp
13121# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13122 cvortex = 6000.0_wp
13123# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13124
13125# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13126 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
13127# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13128 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
13129# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13130
13131# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13132 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
13133# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13134 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
13135# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13136 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
13137# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13138 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
13139# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13140 case (272) ! Premixed Flame Instability
13141# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13142 if (.not. files_loaded) then
13143# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13144 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13145# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13146 do f = 1, max_files
13147# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13148 write (file_num_str, '(I0)') f
13149# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13150 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
13151# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13152 end do
13153# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13154
13155# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13156 ! Common file reading setup
13157# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13158 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13159# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13160 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13161# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13162
13163# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13164 select case (num_dims)
13165# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13166 case (1, 2) ! 1D and 2D cases are similar
13167# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13168 ! Count lines
13169# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13170 line_count = 0
13171# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13172 do
13173# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13174 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13175# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13176 if (ios2 /= 0) exit
13177# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13178 line_count = line_count + 1
13179# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13180 end do
13181# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13182 close (unit2)
13183# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13184
13185# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13186 xrows = line_count
13187# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13188 yrows = 1
13189# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13190 index_x = 0
13191# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13192 if (num_dims == 2) index_x = i
13193# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13194#ifdef MFC_DEBUG
13195# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13196 block
13197# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13198 use iso_fortran_env, only: output_unit
13199# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13200
13201# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13202 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13203# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13204
13205# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13206 call flush (output_unit)
13207# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13208 end block
13209# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13210#endif
13211# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13212 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13213# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13214
13215# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13216
13217# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13218
13219# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13220#if defined(MFC_OpenACC)
13221# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13222!$acc enter data create(x_coords, stored_values)
13223# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13224#elif defined(MFC_OpenMP)
13225# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13226!$omp target enter data map(always,alloc:x_coords, stored_values)
13227# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13228#endif
13229# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13230
13231# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13232 ! Read data from all files
13233# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13234 do f = 1, max_files
13235# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13236 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13237# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13238 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13239# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13240
13241# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242 do iter = 1, xrows
13243# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13245# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13247# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248 end do
13249# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250 close (unit)
13251# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 end do
13253# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254
13255# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13256 ! Calculate offsets
13257# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13258 domain_xstart = x_coords(1)
13259# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13260 x_step = x_cc(1) - x_cc(0)
13261# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13262 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
13263# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13264 global_offset_x = nint(abs(delta_x)/x_step)
13265# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13266 case (3) ! 3D case - determine grid structure
13267# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13268 ! Find yRows by counting rows with same x
13269# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13270 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13271# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13272 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13273# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13274
13275# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13276 yrows = 1
13277# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13278 do
13279# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13280 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13281# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13282 if (ios2 /= 0) exit
13283# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13284 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13285# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13286 yrows = yrows + 1
13287# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13288 else
13289# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13290 exit
13291# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13292 end if
13293# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13294 end do
13295# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13296 close (unit2)
13297# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13298
13299# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13300 ! Count total rows
13301# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13302 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13303# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13304 nrows = 0
13305# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13306 do
13307# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13309# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310 if (ios2 /= 0) exit
13311# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312 nrows = nrows + 1
13313# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314 end do
13315# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316 close (unit2)
13317# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318
13319# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320 xrows = nrows/yrows
13321# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322#ifdef MFC_DEBUG
13323# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324 block
13325# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326 use iso_fortran_env, only: output_unit
13327# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328
13329# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13331# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332
13333# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334 call flush (output_unit)
13335# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336 end block
13337# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338#endif
13339# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13341# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342
13343# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13344
13345# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13346
13347# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13348
13349# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13350#if defined(MFC_OpenACC)
13351# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13352!$acc enter data create(x_coords, y_coords, stored_values)
13353# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13354#elif defined(MFC_OpenMP)
13355# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13356!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13357# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13358#endif
13359# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13360 index_x = i
13361# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13362 index_y = j
13363# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13364
13365# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13366 ! Read all files
13367# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13368 do f = 1, max_files
13369# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13370 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13371# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13372 if (ios /= 0) then
13373# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13374 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13375# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13376 cycle
13377# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13378 end if
13379# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13380
13381# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13382 iter = 0
13383# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13384 do iix = 1, xrows
13385# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13386 do iiy = 1, yrows
13387# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13388 iter = iter + 1
13389# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13390 if (f == 1) then
13391# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13392 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13393# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13394 else
13395# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13396 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13397# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13398 end if
13399# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13400 if (ios /= 0) call s_mpi_abort("Error reading data")
13401# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13402 end do
13403# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13404 end do
13405# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13406 close (unit)
13407# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13408 end do
13409# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13410
13411# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13412 ! Calculate offsets
13413# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13414 x_step = x_cc(1) - x_cc(0)
13415# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13416 y_step = y_cc(1) - y_cc(0)
13417# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13418 delta_x = x_cc(index_x) - x_coords(1)
13419# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13420 delta_y = y_cc(index_y) - y_coords(1)
13421# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13422 global_offset_x = nint(abs(delta_x)/x_step)
13423# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13424 global_offset_y = nint(abs(delta_y)/y_step)
13425# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426 end select
13427# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428
13429# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 files_loaded = .true.
13431# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13432 end if
13433# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13434
13435# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13436 ! Data assignment
13437# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13438 select case (num_dims)
13439# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13440 case (1)
13441# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 idx = i + 1 + global_offset_x
13443# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 ! idx must land inside the file's row range: this rank's subdomain offset
13445# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13446 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
13447# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13448 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
13449# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13450 if (idx < 1 .or. idx > xrows) &
13451# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13452 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13453# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13454 do f = 1, sys_size
13455# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13456 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13457# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13458 end do
13459# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13460 case (2)
13461# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13462 idx = i + 1 + global_offset_x - index_x
13463# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13464 if (idx < 1 .or. idx > xrows) &
13465# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13466 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13467# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13468 do f = 1, sys_size - 1
13469# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13470 jump = merge(1, 0, f >= eqn_idx%mom%end)
13471# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13472 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13473# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13474 end do
13475# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13476 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13477# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13478 case (3)
13479# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13480 idx = i + 1 + global_offset_x - index_x
13481# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13482 idy = j + 1 + global_offset_y - index_y
13483# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13484 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
13485# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13486 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
13487# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13488 do f = 1, sys_size - 1
13489# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13490 jump = merge(1, 0, f >= eqn_idx%mom%end)
13491# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13492 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13493# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13494 end do
13495# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13496 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13497# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13498 end select
13499# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13500
13501# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13502 y_center = y0_ref
13503# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13504 y_dist = y_cc(j) - y_center
13505# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13506 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
13507# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13508 front_shift = a_param*sin(wave_phase)
13509# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13510
13511# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13512 x_mapped = x_cc(i) - front_shift
13513# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13514
13515# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13516 if (x_mapped <= x_coords(1)) then
13517# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13518 do v = 1, sys_size - 1
13519# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13520 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
13521# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13522 end do
13523# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13524 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13525# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13526 else if (x_mapped >= x_coords(xrows)) then
13527# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13528 do v = 1, sys_size - 1
13529# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13530 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
13531# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13532 end do
13533# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13534 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13535# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13536 else
13537# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13538 idx_lo = 1; idx_hi = xrows
13539# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13540 do while (idx_hi - idx_lo > 1)
13541# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13542 idx_mid = (idx_lo + idx_hi)/2
13543# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13544 if (x_coords(idx_mid) <= x_mapped) then
13545# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13546 idx_lo = idx_mid
13547# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13548 else
13549# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13550 idx_hi = idx_mid
13551# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13552 end if
13553# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13554 end do
13555# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13556
13557# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13558 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
13559# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13560
13561# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13562 do v = 1, sys_size - 1
13563# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13564 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
13565# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13566 & v) + interp_wt*stored_values(idx_hi, 1, v)
13567# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13568 end do
13569# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13570 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13571# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13572 end if
13573# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13574 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
13575# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13576 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
13577# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13578 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
13579# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13580 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
13581# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13582 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
13583# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13584 & - y_domain%beg))
13585# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13586 if (x_cc(i) > d) then
13587# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13588 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
13589# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13590 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
13591# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13592 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
13593# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13594 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
13595# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13596 do v = eqn_idx%species%beg, eqn_idx%species%end
13597# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13598 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
13599# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13600 end do
13601# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13602 end if
13603# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13604 case (280) ! Isentropic vortex
13605# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13606 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
13607# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13608 ! geometry 2
13609# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13610 if (patch_id == 1) then
13611# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612 q_prim_vf(eqn_idx%E)%sf(i, j, &
13613# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614 & 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) &
13615# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
13617# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
13619# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 & 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) &
13621# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
13623# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
13625# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626 & 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) &
13627# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
13629# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
13631# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632 & 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) &
13633# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
13635# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636 end if
13637# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638 case (281) ! Acoustic pulse
13639# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
13641# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642 ! geometry 2
13643# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644 if (patch_id == 2) then
13645# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 q_prim_vf(eqn_idx%E)%sf(i, j, &
13647# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 & 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))
13649# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
13651# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 & 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))
13653# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654 end if
13655# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656 case (282) ! Zero-circulation vortex
13657# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
13659# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660 ! geometry 2
13661# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662 if (patch_id == 2) then
13663# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 q_prim_vf(eqn_idx%E)%sf(i, j, &
13665# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666 & 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))
13667# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
13669# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 & 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))
13671# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
13673# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
13675# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
13677# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
13679# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 end if
13681# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
13683# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
13685# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
13687# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
13689# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690 ! patch_icpp(patch_id)%epsilon; defaults to 5.
13691# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692 if (patch_id == 1) then
13693# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
13695# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
13697# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
13699# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
13701# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702 do igq = 1, 3
13703# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704 do jgq = 1, 3
13705# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
13707# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
13709# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
13711# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712 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))
13713# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714 wq = gauss_w(igq)*gauss_w(jgq)
13715# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716 rhoq = t_facq**1.4_wp
13717# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718 pq = t_facq**2.4_wp
13719# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
13721# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722 & - r2q)
13723# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
13725# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726 & - r2q)
13727# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
13729# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730 rho_avg = rho_avg + wq*rhoq
13731# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 rhou_avg = rhou_avg + wq*(rhoq*uq)
13733# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 rhov_avg = rhov_avg + wq*(rhoq*vq)
13735# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736 e_avg = e_avg + wq*eq
13737# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738 end do
13739# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740 end do
13741# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 rho_avg = rho_avg*0.25_wp
13743# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 rhou_avg = rhou_avg*0.25_wp
13745# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 rhov_avg = rhov_avg*0.25_wp
13747# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 e_avg = e_avg*0.25_wp
13749# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
13751# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
13753# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
13755# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
13757# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 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
13759# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760 end if
13761# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 case (291) ! Isothermal Flat Plate
13763# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 t_inf = 1125.0_wp
13765# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766 t_wall = 600.0_wp
13767# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768 p_atm = 101325.0_wp
13769# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770
13771# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772 ! Boundary/Shear Layer thicknesses
13773# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774 delta_th = 0.0003_wp ! Thermal BL thickness
13775# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776 delta_shear = 8e-3_wp ! Velocity BL thickness
13777# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778
13779# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780 u_max = 50.0_wp ! Freestream Velocity (m/s)
13781# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782
13783# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784 mw_n2 = 28.0134e-3_wp
13785# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786 mw_o2 = 31.999e-3_wp
13787# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788 y_n2 = 0.767_wp
13789# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790 y_o2 = 0.233_wp
13791# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
13793# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794 bottom_blend_u = tanh(y_cc(j)/delta_shear)
13795# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796 bottom_blend_t = tanh(y_cc(j)/delta_th)
13797# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798 u_mean = u_max*bottom_blend_u
13799# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
13801# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
13803# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
13805# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13807# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
13809# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
13811# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
13813# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814 case default
13815# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 if (proc_rank == 0) then
13817# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818 call s_int_to_str(patch_id, istr)
13819# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
13821# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822 end if
13823# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824 end select
13825 end if
13826
13827 ! Updating the patch identities bookkeeping variable
13828 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
13829 end if
13830 end do
13831 end do
13832 if (allocated(stored_values)) then
13833# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834#ifdef MFC_DEBUG
13835# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836 block
13837# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 use iso_fortran_env, only: output_unit
13839# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840
13841# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(stored_values)'
13843# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844
13845# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846 call flush (output_unit)
13847# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848 end block
13849# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850#endif
13851# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852
13853# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854#if defined(MFC_OpenACC)
13855# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856!$acc exit data delete(stored_values)
13857# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858#elif defined(MFC_OpenMP)
13859# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860!$omp target exit data map(release:stored_values)
13861# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862#endif
13863# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864 deallocate (stored_values)
13865# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866#ifdef MFC_DEBUG
13867# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868 block
13869# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870 use iso_fortran_env, only: output_unit
13871# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872
13873# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(x_coords)'
13875# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876
13877# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878 call flush (output_unit)
13879# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880 end block
13881# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882#endif
13883# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884
13885# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886#if defined(MFC_OpenACC)
13887# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888!$acc exit data delete(x_coords)
13889# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890#elif defined(MFC_OpenMP)
13891# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892!$omp target exit data map(release:x_coords)
13893# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894#endif
13895# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896 deallocate (x_coords)
13897# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898 end if
13899# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900
13901# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902 if (allocated(y_coords)) then
13903# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904#ifdef MFC_DEBUG
13905# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906 block
13907# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908 use iso_fortran_env, only: output_unit
13909# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910
13911# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(y_coords)'
13913# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914
13915# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 call flush (output_unit)
13917# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 end block
13919# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920#endif
13921# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922
13923# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924#if defined(MFC_OpenACC)
13925# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926!$acc exit data delete(y_coords)
13927# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928#elif defined(MFC_OpenMP)
13929# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930!$omp target exit data map(release:y_coords)
13931# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932#endif
13933# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 deallocate (y_coords)
13935# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936 end if
13937# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938
13939# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 files_loaded = .false.
13941# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942
13943# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944 if (allocated(stored_values274)) then
13945# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946#ifdef MFC_DEBUG
13947# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 block
13949# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 use iso_fortran_env, only: output_unit
13951# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952
13953# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(stored_values274)'
13955# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956
13957# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 call flush (output_unit)
13959# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 end block
13961# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962#endif
13963# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964
13965# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966#if defined(MFC_OpenACC)
13967# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968!$acc exit data delete(stored_values274)
13969# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970#elif defined(MFC_OpenMP)
13971# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972!$omp target exit data map(release:stored_values274)
13973# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974#endif
13975# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 deallocate (stored_values274)
13977# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 end if
13979# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980
13981# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 files_loaded274 = .false.
13983
13984 end subroutine s_icpp_ellipse
13985
13986 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
13987 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
13988 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
13989
13990 ! Patch identifier
13991 integer, intent(in) :: patch_id
13992
13993#ifdef MFC_MIXED_PRECISION
13994 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13995#else
13996 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
13997#endif
13998 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13999
14000 ! Generic loop iterators
14001 integer :: i, j, k
14002 real(wp) :: a, b, c
14003
14004 integer :: xRows, yRows, nRows, iix, iiy, max_files
14005# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14006 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
14007# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14008 real(wp) :: x_step, y_step
14009# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14010 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14011# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14012 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
14013# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14014 real(wp) :: delta_x, delta_y
14015# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14016 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
14017# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14018 real(wp), allocatable :: stored_values(:,:,:)
14019# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14020 real(wp), allocatable :: x_coords(:), y_coords(:)
14021# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14022 logical :: files_loaded = .false.
14023# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14024 real(wp) :: domain_xstart
14025# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14026 character(len=20) :: file_num_str !< For storing the file number as a string
14027# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14028 integer :: ios
14029# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14030 integer :: ios2
14031# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14032
14033# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14034 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
14035# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14036 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
14037# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14038 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
14039# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14040 ! y_coords/files_loaded above.
14041# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14042 real(wp), allocatable, dimension(:,:,:) :: stored_values274
14043# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14044 logical :: files_loaded274 = .false.
14045# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14046 integer :: f274, ix274, iy274, unit274, ios274
14047# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14048 integer :: local_ix_beg274, local_iy_beg274
14049# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14050 character(len=300) :: fname274
14051# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14052 character(len=20) :: file_num_str274
14053# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14054 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
14055# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14056 real(wp) :: file_dx274, file_dy274, r_align274
14057 ! Place any declaration of intermediate variables here
14058# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14059 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14060# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14061 real(wp) :: eps
14062# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14063
14064# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14065 ! IGR Jets Arrays to stor position and radii of jets from input file
14066# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14067 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14068# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14069 ! Variables to describe initial condition of jet
14070# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14071 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14072# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14073 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
14074# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075 real(wp), dimension(0:n,0:p) :: rcut_arr
14076# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077 integer :: l, q, s !< Iterators for reading input files
14078# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 integer :: start, end !< Ints to keep track of position in file
14080# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081 character(len=100000) :: line ! String to store line in file
14082# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083 character(len=25) :: value !< String to store value in line
14084# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085 integer :: NJet !< Number of jets
14086# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
14088# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089 logical :: file_exist ! Flag to check if file exists
14090# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091
14092# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093 eps = 1e-9_wp
14094# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095
14096# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
14098# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099 eps_smooth = 3._wp
14100# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101 inquire (file="njet.txt", exist=file_exist)
14102# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103 if (file_exist) then
14104# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105 open (unit=10, file="njet.txt", status="old", action="read")
14106# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107 read (10, *) njet
14108# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 close (10)
14110# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14111 else
14112# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14113 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
14114# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14115 end if
14116# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14117
14118# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14119#ifdef MFC_DEBUG
14120# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14121 block
14122# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14123 use iso_fortran_env, only: output_unit
14124# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14125
14126# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14127 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
14128# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14129
14130# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14131 call flush (output_unit)
14132# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14133 end block
14134# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14135#endif
14136# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14137 allocate (y_th_arr(0:njet - 1))
14138# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14139
14140# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14141
14142# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14143#if defined(MFC_OpenACC)
14144# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14145!$acc enter data create(y_th_arr)
14146# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14147#elif defined(MFC_OpenMP)
14148# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14149!$omp target enter data map(always,alloc:y_th_arr)
14150# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14151#endif
14152# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14153#ifdef MFC_DEBUG
14154# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14155 block
14156# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14157 use iso_fortran_env, only: output_unit
14158# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14159
14160# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14161 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
14162# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14163
14164# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14165 call flush (output_unit)
14166# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14167 end block
14168# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14169#endif
14170# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14171 allocate (z_th_arr(0:njet - 1))
14172# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14173
14174# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14175
14176# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14177#if defined(MFC_OpenACC)
14178# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14179!$acc enter data create(z_th_arr)
14180# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14181#elif defined(MFC_OpenMP)
14182# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14183!$omp target enter data map(always,alloc:z_th_arr)
14184# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14185#endif
14186# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14187#ifdef MFC_DEBUG
14188# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14189 block
14190# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14191 use iso_fortran_env, only: output_unit
14192# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14193
14194# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14195 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
14196# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14197
14198# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14199 call flush (output_unit)
14200# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14201 end block
14202# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14203#endif
14204# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14205 allocate (r_th_arr(0:njet - 1))
14206# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14207
14208# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14209
14210# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14211#if defined(MFC_OpenACC)
14212# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14213!$acc enter data create(r_th_arr)
14214# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14215#elif defined(MFC_OpenMP)
14216# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14217!$omp target enter data map(always,alloc:r_th_arr)
14218# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14219#endif
14220# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14221
14222# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14223 inquire (file="jets.csv", exist=file_exist)
14224# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14225 if (file_exist) then
14226# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14227 open (unit=10, file="jets.csv", status="old", action="read")
14228# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14229 do q = 0, njet - 1
14230# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 read (10, '(A)') line ! Read a full line as a string
14232# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233 start = 1
14234# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235
14236# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237 do l = 0, 2
14238# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239 end = index(line(start:), ',') ! Find the next comma
14240# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241 if (end == 0) then
14242# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243 value = trim(adjustl(line(start:))) ! Last value in the line
14244# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245 else
14246# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14248# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249 start = start + end ! Move to next value
14250# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251 end if
14252# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253 if (l == 0) then
14254# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255 read (value, *) y_th_arr(q) ! Convert string to numeric value
14256# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257 else if (l == 1) then
14258# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259 read (value, *) z_th_arr(q)
14260# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261 else
14262# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263 read (value, *) r_th_arr(q)
14264# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265 end if
14266# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267 end do
14268# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269 end do
14270# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271 close (10)
14272# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273
14274# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275 do q = 0, p
14276# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277 do l = 0, n
14278# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279 rcut = 0._wp
14280# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281 do s = 0, njet - 1
14282# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14284# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14286# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 end do
14288# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14289 rcut_arr(l, q) = rcut
14290# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14291 end do
14292# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14293 end do
14294# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14295 else
14296# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14297 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
14298# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14299 end if
14300# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14301 end if
14302# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14303
14304# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14305 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
14306# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14307#ifdef MFC_DEBUG
14308# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14309 block
14310# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14311 use iso_fortran_env, only: output_unit
14312# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14313
14314# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14315 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
14316# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317
14318# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 call flush (output_unit)
14320# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 end block
14322# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323#endif
14324# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325 allocate (ih(0:n_glb, 0:p_glb))
14326# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14327
14328# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14329
14330# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14331#if defined(MFC_OpenACC)
14332# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14333!$acc enter data create(ih)
14334# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14335#elif defined(MFC_OpenMP)
14336# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14337!$omp target enter data map(always,alloc:ih)
14338# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14339#endif
14340# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341
14342# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 if (interface_file == '.') then
14344# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14345 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
14346# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14347 else
14348# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14349 inquire (file=trim(interface_file), exist=file_exist)
14350# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14351 if (file_exist) then
14352# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14353 open (unit=10, file=trim(interface_file), status="old", action="read")
14354# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14355 do i = 0, n_glb
14356# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14357 read (10, '(A)') line ! Read a full line as a string
14358# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14359 start = 1
14360# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14361
14362# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14363 do j = 0, p_glb
14364# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14365 end = index(line(start:), ',') ! Find the next comma
14366# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14367 if (end == 0) then
14368# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14369 value = trim(adjustl(line(start:))) ! Last value in the line
14370# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14371 else
14372# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14373 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14374# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14375 start = start + end ! Move to next value
14376# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14377 end if
14378# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14379 read (value, *) ih(i, j) ! Convert string to numeric value
14380# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14381 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
14382# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14383 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
14384# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14385 end do
14386# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14387 end do
14388# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14389 close (10)
14390# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14391 else
14392# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14393 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
14394# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14395 end if
14396# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14397 end if
14398# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14399 end if
14400# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14401
14402# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14403 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
14404# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14405#ifdef MFC_DEBUG
14406# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14407 block
14408# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14409 use iso_fortran_env, only: output_unit
14410# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14411
14412# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14413 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
14414# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14415
14416# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14417 call flush (output_unit)
14418# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14419 end block
14420# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14421#endif
14422# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14423 allocate (ih(0:n_glb, 0:0))
14424# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14425
14426# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14427
14428# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14429#if defined(MFC_OpenACC)
14430# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14431!$acc enter data create(ih)
14432# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14433#elif defined(MFC_OpenMP)
14434# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14435!$omp target enter data map(always,alloc:ih)
14436# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14437#endif
14438# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14439 if (interface_file == '.') then
14440# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14441 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
14442# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14443 else
14444# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14445 inquire (file=trim(interface_file), exist=file_exist)
14446# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14447 if (file_exist) then
14448# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14449 open (unit=10, file=trim(interface_file), status="old", action="read")
14450# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14451 do i = 0, n_glb
14452# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14453 read (10, '(A)') line ! Read a full line as a string
14454# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14455 value = trim(line)
14456# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14457 read (value, *) ih(i, 0) ! Convert string to numeric value
14458# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14459 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
14460# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14461 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
14462# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14463 end do
14464# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14465 close (10)
14466# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14467 else
14468# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14469 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
14470# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14471 end if
14472# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14473 end if
14474# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14475 end if
14476
14477 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
14478 x_centroid = patch_icpp(patch_id)%x_centroid
14479 y_centroid = patch_icpp(patch_id)%y_centroid
14480 z_centroid = patch_icpp(patch_id)%z_centroid
14481 a = patch_icpp(patch_id)%radii(1)
14482 b = patch_icpp(patch_id)%radii(2)
14483 c = patch_icpp(patch_id)%radii(3)
14484 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14485 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14486
14487 ! Initialize eta=1; modified if smoothing is enabled
14488 eta = 1._wp
14489
14490 ! Assign patch vars if cell is covered and patch has write permission
14491 do k = 0, p
14492 do j = 0, n
14493 do i = 0, m
14494 if (grid_geometry == 3) then
14496 else
14497 cart_y = y_cc(j)
14498 cart_z = z_cc(k)
14499 end if
14500
14501 if (patch_icpp(patch_id)%smoothen) then
14502 eta = tanh(smooth_coeff/min(dx_min, dy_min, &
14503 & dz_min)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
14504 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
14505 end if
14506
14507 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp &
14508 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
14509 & k) == smooth_patch_id) then
14510 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
14511
14512
14513 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14514 select case (patch_icpp(patch_id)%hcid)
14515# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14516 case (300) ! Rayleigh-Taylor instability
14517# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14518 rhoh = 3._wp
14519# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14520 rhol = 1._wp
14521# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14522 pref = 1.e5_wp
14523# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14524 pint = pref
14525# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14526 h = 0.7_wp
14527# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14528 lam = 0.2_wp
14529# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14530 wl = 2._wp*pi/lam
14531# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14532 amp = 0.025_wp/wl
14533# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14534
14535# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14536 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
14537# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14538
14539# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14540 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14541# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14542
14543# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14544 if (alph < eps) alph = eps
14545# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14546 if (alph > 1._wp - eps) alph = 1._wp - eps
14547# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14548
14549# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14550 if (y_cc(j) > inth) then
14551# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14552 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14553# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14554 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14555# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14556 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
14557# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14558 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
14559# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14560 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14561# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14562 else
14563# 574 "/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# 574 "/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# 574 "/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# 574 "/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# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14572 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14573# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14574 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14575# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14576 end if
14577# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14578 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14579# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14580 h = 0.0_wp
14581# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14582 lam = 1.0_wp
14583# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14584 amp = patch_icpp(patch_id)%a(2)
14585# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14586 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14587# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14588 if (x_cc(i) > inth) then
14589# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14590 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14591# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14592 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14593# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14594 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
14595# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14596 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14597# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14598 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14599# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14600 end if
14601# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14602 case (302) ! 3D Jet with IGR
14603# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14604 ux_th = 10*sqrt(1.4*0.4)
14605# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14606 ux_am = 0.0*sqrt(1.4)
14607# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14608 p_th = 2.0_wp
14609# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14610 p_am = 1.0_wp
14611# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14612 rho_th = 1._wp
14613# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14614 rho_am = 1._wp
14615# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14616 y_th = 0.0_wp
14617# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14618 z_th = 0.0_wp
14619# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14620 r_th = 1._wp
14621# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14622 eps_smooth = 1._wp
14623# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14624 eps = 1e-6
14625# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14626
14627# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14628 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14629# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14630 rcut = f_cut_on(r - r_th, eps_smooth)
14631# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14632 xcut = f_cut_on(x_cc(i), eps_smooth)
14633# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14634
14635# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14636 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14637# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14638 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14639# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14640 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14641# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14642
14643# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14644 if (num_fluids == 1) then
14645# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14646 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14647# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14648 else
14649# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14650 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14651# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14652 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14653# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14654 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))
14655# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14656 end if
14657# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14658
14659# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14660 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14661# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14662 case (303) ! 3D Multijet
14663# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14664 eps_smooth = 3.0_wp
14665# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14666 ux_th = 10*sqrt(1.4*0.4)
14667# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14668 ux_am = 2.5*sqrt(1.4*0.4)
14669# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14670 p_th = 0.8_wp
14671# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14672 p_am = 0.4_wp
14673# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14674 rho_th = 1._wp
14675# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14676 rho_am = 1._wp
14677# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14678 eps = 1e-6
14679# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14680
14681# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14682 rcut = rcut_arr(j, k)
14683# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14684 xcut = f_cut_on(x_cc(i), eps_smooth)
14685# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14686
14687# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14688 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14689# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14690 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
14691# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14692 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
14693# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14694
14695# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14696 if (num_fluids == 1) then
14697# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14698 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14699# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14700 else
14701# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14702 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14703# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14704 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
14705# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14706 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))
14707# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14708 end if
14709# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14710
14711# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14712 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
14713# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14714 case (304) ! 3D Interface from file cartesian
14715# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14716 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
14717# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14718
14719# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14720 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14721# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14722 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14723# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14724
14725# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14726 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
14727# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14728 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
14729# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14730
14731# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14732 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
14733# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14734 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
14735# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14736
14737# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14738 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
14739# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14740 case (305) ! 3D Interface from file axisymmetric
14741# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14742 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
14743# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14744
14745# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14746 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
14747# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14748 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
14749# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14750
14751# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14752 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
14753# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14754 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
14755# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14756
14757# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14758 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
14759# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14760 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
14761# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14762
14763# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14764 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
14765# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14766 case (370) ! 3D extrusion of 2D profile from external data
14767# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14768 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14769# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14770 if (.not. files_loaded) then
14771# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14772 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14773# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14774 do f = 1, max_files
14775# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14776 write (file_num_str, '(I0)') f
14777# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14778 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
14779# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14780 end do
14781# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14782
14783# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14784 ! Common file reading setup
14785# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14786 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14787# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14788 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14789# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14790
14791# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14792 select case (num_dims)
14793# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14794 case (1, 2) ! 1D and 2D cases are similar
14795# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14796 ! Count lines
14797# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14798 line_count = 0
14799# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14800 do
14801# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14802 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14803# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14804 if (ios2 /= 0) exit
14805# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14806 line_count = line_count + 1
14807# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14808 end do
14809# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14810 close (unit2)
14811# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14812
14813# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14814 xrows = line_count
14815# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14816 yrows = 1
14817# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14818 index_x = 0
14819# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14820 if (num_dims == 2) index_x = i
14821# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14822#ifdef MFC_DEBUG
14823# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14824 block
14825# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14826 use iso_fortran_env, only: output_unit
14827# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14828
14829# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14830 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14831# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14832
14833# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14834 call flush (output_unit)
14835# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14836 end block
14837# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14838#endif
14839# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14840 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14841# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14842
14843# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14844
14845# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14846
14847# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14848#if defined(MFC_OpenACC)
14849# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14850!$acc enter data create(x_coords, stored_values)
14851# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14852#elif defined(MFC_OpenMP)
14853# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14854!$omp target enter data map(always,alloc:x_coords, stored_values)
14855# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14856#endif
14857# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14858
14859# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14860 ! Read data from all files
14861# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14862 do f = 1, max_files
14863# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14864 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14865# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14866 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14867# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14868
14869# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14870 do iter = 1, xrows
14871# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14872 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14873# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14874 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14875# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14876 end do
14877# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14878 close (unit)
14879# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14880 end do
14881# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14882
14883# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14884 ! Calculate offsets
14885# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14886 domain_xstart = x_coords(1)
14887# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14888 x_step = x_cc(1) - x_cc(0)
14889# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14890 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
14891# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14892 global_offset_x = nint(abs(delta_x)/x_step)
14893# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14894 case (3) ! 3D case - determine grid structure
14895# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14896 ! Find yRows by counting rows with same x
14897# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14898 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14899# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14900 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14901# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14902
14903# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14904 yrows = 1
14905# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14906 do
14907# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14909# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910 if (ios2 /= 0) exit
14911# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
14913# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914 yrows = yrows + 1
14915# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916 else
14917# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918 exit
14919# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920 end if
14921# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922 end do
14923# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924 close (unit2)
14925# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926
14927# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928 ! Count total rows
14929# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14931# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932 nrows = 0
14933# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934 do
14935# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14937# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938 if (ios2 /= 0) exit
14939# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940 nrows = nrows + 1
14941# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942 end do
14943# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944 close (unit2)
14945# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946
14947# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948 xrows = nrows/yrows
14949# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950#ifdef MFC_DEBUG
14951# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952 block
14953# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 use iso_fortran_env, only: output_unit
14955# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956
14957# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14959# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960
14961# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962 call flush (output_unit)
14963# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964 end block
14965# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966#endif
14967# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14969# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970
14971# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972
14973# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974
14975# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976
14977# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978#if defined(MFC_OpenACC)
14979# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980!$acc enter data create(x_coords, y_coords, stored_values)
14981# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982#elif defined(MFC_OpenMP)
14983# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14985# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986#endif
14987# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988 index_x = i
14989# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990 index_y = j
14991# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992
14993# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994 ! Read all files
14995# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996 do f = 1, max_files
14997# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14999# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000 if (ios /= 0) then
15001# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15003# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004 cycle
15005# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006 end if
15007# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008
15009# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010 iter = 0
15011# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15012 do iix = 1, xrows
15013# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15014 do iiy = 1, yrows
15015# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15016 iter = iter + 1
15017# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15018 if (f == 1) then
15019# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15020 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15021# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15022 else
15023# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15024 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15025# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15026 end if
15027# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15028 if (ios /= 0) call s_mpi_abort("Error reading data")
15029# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15030 end do
15031# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15032 end do
15033# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15034 close (unit)
15035# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15036 end do
15037# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15038
15039# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15040 ! Calculate offsets
15041# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15042 x_step = x_cc(1) - x_cc(0)
15043# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15044 y_step = y_cc(1) - y_cc(0)
15045# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15046 delta_x = x_cc(index_x) - x_coords(1)
15047# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15048 delta_y = y_cc(index_y) - y_coords(1)
15049# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15050 global_offset_x = nint(abs(delta_x)/x_step)
15051# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15052 global_offset_y = nint(abs(delta_y)/y_step)
15053# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15054 end select
15055# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15056
15057# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15058 files_loaded = .true.
15059# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15060 end if
15061# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15062
15063# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15064 ! Data assignment
15065# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15066 select case (num_dims)
15067# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15068 case (1)
15069# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15070 idx = i + 1 + global_offset_x
15071# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15072 ! idx must land inside the file's row range: this rank's subdomain offset
15073# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15074 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
15075# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15076 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
15077# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15078 if (idx < 1 .or. idx > xrows) &
15079# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15080 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
15081# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15082 do f = 1, sys_size
15083# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15084 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15085# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15086 end do
15087# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15088 case (2)
15089# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15090 idx = i + 1 + global_offset_x - index_x
15091# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15092 if (idx < 1 .or. idx > xrows) &
15093# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15094 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
15095# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15096 do f = 1, sys_size - 1
15097# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15098 jump = merge(1, 0, f >= eqn_idx%mom%end)
15099# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15100 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15101# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15102 end do
15103# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15104 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
15105# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15106 case (3)
15107# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15108 idx = i + 1 + global_offset_x - index_x
15109# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15110 idy = j + 1 + global_offset_y - index_y
15111# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15112 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
15113# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15114 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
15115# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15116 do f = 1, sys_size - 1
15117# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15118 jump = merge(1, 0, f >= eqn_idx%mom%end)
15119# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15120 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15121# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15122 end do
15123# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15124 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
15125# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15126 end select
15127# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15128 case (380) ! Taylor-Green vortex
15129# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15130 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
15131# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15132 ! geometry 9
15133# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15134 mach = 0.1
15135# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15136 if (patch_id == 1) then
15137# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15138 q_prim_vf(eqn_idx%E)%sf(i, j, &
15139# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15140 & 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)
15141# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15142 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)
15143# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15144 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)
15145# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15146 end if
15147# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15148 case default
15149# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15150 call s_int_to_str(patch_id, istr)
15151# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15152 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
15153# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15154 end select
15155 end if
15156
15157 ! Updating the patch identities bookkeeping variable
15158 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15159 end if
15160 end do
15161 end do
15162 end do
15163 if (allocated(stored_values)) then
15164# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15165#ifdef MFC_DEBUG
15166# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15167 block
15168# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15169 use iso_fortran_env, only: output_unit
15170# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15171
15172# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15173 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(stored_values)'
15174# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15175
15176# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15177 call flush (output_unit)
15178# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15179 end block
15180# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15181#endif
15182# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15183
15184# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15185#if defined(MFC_OpenACC)
15186# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15187!$acc exit data delete(stored_values)
15188# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15189#elif defined(MFC_OpenMP)
15190# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15191!$omp target exit data map(release:stored_values)
15192# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15193#endif
15194# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15195 deallocate (stored_values)
15196# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15197#ifdef MFC_DEBUG
15198# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15199 block
15200# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15201 use iso_fortran_env, only: output_unit
15202# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15203
15204# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15205 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(x_coords)'
15206# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15207
15208# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15209 call flush (output_unit)
15210# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15211 end block
15212# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15213#endif
15214# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15215
15216# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15217#if defined(MFC_OpenACC)
15218# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15219!$acc exit data delete(x_coords)
15220# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15221#elif defined(MFC_OpenMP)
15222# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15223!$omp target exit data map(release:x_coords)
15224# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15225#endif
15226# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15227 deallocate (x_coords)
15228# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15229 end if
15230# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15231
15232# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15233 if (allocated(y_coords)) then
15234# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15235#ifdef MFC_DEBUG
15236# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15237 block
15238# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15239 use iso_fortran_env, only: output_unit
15240# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15241
15242# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15243 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(y_coords)'
15244# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15245
15246# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15247 call flush (output_unit)
15248# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15249 end block
15250# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15251#endif
15252# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15253
15254# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15255#if defined(MFC_OpenACC)
15256# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15257!$acc exit data delete(y_coords)
15258# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15259#elif defined(MFC_OpenMP)
15260# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15261!$omp target exit data map(release:y_coords)
15262# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15263#endif
15264# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15265 deallocate (y_coords)
15266# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15267 end if
15268# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15269
15270# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15271 files_loaded = .false.
15272# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15273
15274# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15275 if (allocated(stored_values274)) then
15276# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15277#ifdef MFC_DEBUG
15278# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15279 block
15280# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15281 use iso_fortran_env, only: output_unit
15282# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15283
15284# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15285 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(stored_values274)'
15286# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15287
15288# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15289 call flush (output_unit)
15290# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15291 end block
15292# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15293#endif
15294# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15295
15296# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15297#if defined(MFC_OpenACC)
15298# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15299!$acc exit data delete(stored_values274)
15300# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15301#elif defined(MFC_OpenMP)
15302# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15303!$omp target exit data map(release:stored_values274)
15304# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15305#endif
15306# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15307 deallocate (stored_values274)
15308# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15309 end if
15310# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15311
15312# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15313 files_loaded274 = .false.
15314
15315 end subroutine s_icpp_ellipsoid
15316
15317 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
15318 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
15319 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
15320 !! allow for the smoothing of its boundaries.
15321 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
15322
15323 integer, intent(in) :: patch_id
15324
15325#ifdef MFC_MIXED_PRECISION
15326 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15327#else
15328 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15329#endif
15330 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15331 integer :: i, j, k !< generic loop iterators
15332
15333 integer :: xRows, yRows, nRows, iix, iiy, max_files
15334# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15335 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
15336# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15337 real(wp) :: x_step, y_step
15338# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15339 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15340# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15341 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
15342# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15343 real(wp) :: delta_x, delta_y
15344# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15345 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
15346# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15347 real(wp), allocatable :: stored_values(:,:,:)
15348# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15349 real(wp), allocatable :: x_coords(:), y_coords(:)
15350# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15351 logical :: files_loaded = .false.
15352# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15353 real(wp) :: domain_xstart
15354# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15355 character(len=20) :: file_num_str !< For storing the file number as a string
15356# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15357 integer :: ios
15358# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15359 integer :: ios2
15360# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15361
15362# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15363 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
15364# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15365 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
15366# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
15368# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369 ! y_coords/files_loaded above.
15370# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 real(wp), allocatable, dimension(:,:,:) :: stored_values274
15372# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373 logical :: files_loaded274 = .false.
15374# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 integer :: f274, ix274, iy274, unit274, ios274
15376# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 integer :: local_ix_beg274, local_iy_beg274
15378# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 character(len=300) :: fname274
15380# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381 character(len=20) :: file_num_str274
15382# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
15384# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385 real(wp) :: file_dx274, file_dy274, r_align274
15386 ! Place any declaration of intermediate variables here
15387# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15388 real(wp) :: eps, eps_mhd, C_mhd
15389# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15390 real(wp) :: r, rmax, gam, umax, p0
15391# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15392 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
15393# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15394 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
15395# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15396 real(wp) :: r0, alpha, r2
15397# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15398 real(wp) :: sinA, cosA
15399# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15400 real(wp) :: r_sq
15401# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15402
15403# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15404 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
15405# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15406 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
15407# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15408 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
15409# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15410 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
15411# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15412 integer :: igq, jgq
15413# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15414
15415# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15416 ! # 291 - Shear/Thermal Layer Case
15417# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15418 real(wp) :: delta_shear, u_max, u_mean
15419# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15420 real(wp) :: T_wall, T_inf, P_atm, T_loc
15421# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15422 real(wp) :: delta_th, R_mix
15423# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15424 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
15425# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15426 real(wp) :: bottom_blend_u, bottom_blend_T
15427# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15428
15429# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15430 ! # 207
15431# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15432 real(wp) :: sigma, gauss1, gauss2
15433# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15434
15435# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15436 ! # 208
15437# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15438 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
15439# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15440 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
15441# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15442 integer :: v, idx_lo, idx_hi, idx_mid
15443# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15444 real(wp), parameter :: Ly_param = 0.00775735_wp
15445# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15446 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
15447# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15448 integer, parameter :: Nwaves = 6
15449# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15450 real(wp), parameter :: y0_ref = 0.0_wp
15451# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15452
15453# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15454 eps = 1.e-9_wp
15455
15456 ! Transferring the rectangle's centroid and length information
15457 x_centroid = patch_icpp(patch_id)%x_centroid
15458 y_centroid = patch_icpp(patch_id)%y_centroid
15459 length_x = patch_icpp(patch_id)%length_x
15460 length_y = patch_icpp(patch_id)%length_y
15461
15462 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
15463 x_boundary%beg = x_centroid - 0.5_wp*length_x
15464 x_boundary%end = x_centroid + 0.5_wp*length_x
15465 y_boundary%beg = y_centroid - 0.5_wp*length_y
15466 y_boundary%end = y_centroid + 0.5_wp*length_y
15467
15468 ! Set eta=1 (no smoothing for this patch type)
15469 eta = 1._wp
15470
15471 ! Assign patch vars if cell is covered and patch has write permission
15472 do j = 0, n
15473 do i = 0, m
15474 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, 0._wp])) then
15475 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
15476 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
15477
15478
15479
15480 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15481 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
15482# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483 case (200) ! Two-fluid cubic interface
15484# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
15486# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
15488# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
15490# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
15492# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
15494# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
15496# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 end if
15498# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
15500# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
15502# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503 rmax = 0.2_wp
15504# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505
15506# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
15508# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
15510# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
15512# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513
15514# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515 if (r < rmax) then
15516# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
15518# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
15520# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
15522# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523 else if (r < 2*rmax) then
15524# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
15526# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
15528# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 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)))
15530# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 else
15532# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
15534# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
15536# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
15538# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 end if
15540# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
15542# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
15544# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545 rmax = 0.2_wp
15546# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547
15548# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
15550# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
15552# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
15554# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555
15556# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15557 if (r < rmax) then
15558# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15559 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
15560# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15561 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
15562# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15563 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
15564# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15565 else if (r < 2*rmax) then
15566# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15567 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
15568# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15569 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
15570# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15571 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)))
15572# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15573 else
15574# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15575 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
15576# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15577 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
15578# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15579 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
15580# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15581 end if
15582# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15583
15584# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15585 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
15586# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15587 case (204) ! Rayleigh-Taylor instability
15588# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15589 rhoh = 3._wp
15590# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15591 rhol = 1._wp
15592# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 pref = 1.e5_wp
15594# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15595 pint = pref
15596# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15597 h = 0.7_wp
15598# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15599 lam = 0.2_wp
15600# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15601 wl = 2._wp*pi/lam
15602# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15603 amp = 0.05_wp/wl
15604# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15605
15606# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15607 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
15608# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15609
15610# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15611 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15612# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15613
15614# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15615 if (alph < eps) alph = eps
15616# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15617 if (alph > 1._wp - eps) alph = 1._wp - eps
15618# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15619
15620# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15621 if (y_cc(j) > inth) then
15622# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15623 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
15624# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15625 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
15626# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15627 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
15628# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15629 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
15630# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15631 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15632# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15633 else
15634# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15635 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
15636# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15637 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
15638# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15639 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
15640# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15641 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
15642# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15643 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15644# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15645 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
15646# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15647 end if
15648# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15649 case (205) ! 2D lung wave interaction problem
15650# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15651 h = 0.0_wp ! non dim origin y
15652# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15653 lam = 1.0_wp ! non dim lambda
15654# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15655 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
15656# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15657
15658# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15659 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
15660# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15661
15662# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15663 if (y_cc(j) > inth) then
15664# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15665 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
15666# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15667 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
15668# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15669 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
15670# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15671 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
15672# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15673 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
15674# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15675 end if
15676# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15677 case (206) ! 2D lung wave interaction problem - horizontal domain
15678# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15679 h = 0.0_wp ! non dim origin y
15680# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15681 lam = 1.0_wp ! non dim lambda
15682# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15683 amp = patch_icpp(patch_id)%a(2)
15684# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15685
15686# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15687 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
15688# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15689
15690# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15691 if (x_cc(i) > intl) then ! this is the liquid
15692# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15693 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
15694# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15695 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
15696# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15697 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
15698# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15699 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
15700# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15701 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
15702# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15703 end if
15704# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15705 case (207) ! Kelvin Helmholtz Instability
15706# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15707 sigma = 0.05_wp/sqrt(2.0_wp)
15708# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15709 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
15710# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15711 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
15712# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15713 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)
15714# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15715 case (208) ! Richtmeyer Meshkov Instability
15716# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15717 lam = 1.0_wp
15718# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15719 eps = 1.0e-6_wp
15720# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15721 ei = 5.0_wp
15722# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15723 ! Smoothening function to smooth out sharp discontinuity in the interface
15724# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15725 if (x_cc(i) <= 0.7_wp*lam) then
15726# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15727 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
15728# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15729 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
15730# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15731 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
15732# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15733 alpha_sf6 = 1.0_wp - alpha_air
15734# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15735 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
15736# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15737 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
15738# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15739 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
15740# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15741 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
15742# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15743 end if
15744# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15745 case (250) ! MHD Orszag-Tang vortex
15746# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15747 ! 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),
15748# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15749 ! sin(4*pi*x)/sqrt(4*pi), 0)
15750# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15751
15752# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15753 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
15754# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15755 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
15756# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15757
15758# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15759 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
15760# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15761 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
15762# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15763 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
15764# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15765 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
15766# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15767 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
15768# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15769 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
15770# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15771 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
15772# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15773 ! Linear interpolation between r=0.08 and r=1.0
15774# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15775 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
15776# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15777 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
15778# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15779 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
15780# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15781 else
15782# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15783 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
15784# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15785 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
15786# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15787 end if
15788# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15789
15790# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15791 ! case 252 is for the 2D MHD Rotor problem
15792# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15793 case (252) ! 2D MHD Rotor Problem
15794# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15795 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
15796# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15797 !
15798# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15799 ! 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
15800# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15801 ! velocity w=20, giving v_tan=2 at r=0.1
15802# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15803
15804# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15805 ! Calculate distance squared from the center
15806# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15807 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
15808# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15809
15810# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15811 ! inner radius of 0.1
15812# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15813 if (r_sq <= 0.1**2) then
15814# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15815 ! -- Inside the rotor -- Set density uniformly to 10
15816# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15817 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
15818# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15819
15820# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15821 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
15822# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15823 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
15824# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15825 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
15826# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15827
15828# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15829 ! taper width of 0.015
15830# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15831 else if (r_sq <= 0.115**2) then
15832# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15833 ! linearly smooth the function between r = 0.1 and 0.115
15834# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15835 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
15836# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15837
15838# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15839 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)
15840# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15841 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)
15842# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15843 end if
15844# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15845 case (253) ! MHD Smooth Magnetic Vortex
15846# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15847 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
15848# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15849 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
15850# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15851
15852# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15853 ! velocity
15854# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15855 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))
15856# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15857 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))
15858# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15859
15860# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15861 ! magnetic field
15862# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15863 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)
15864# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15865 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)
15866# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15867
15868# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15869 ! pressure
15870# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15871 q_prim_vf(eqn_idx%E)%sf(i, j, &
15872# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15873 & 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)
15874# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15875 case (260) ! Gaussian Divergence Pulse
15876# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15877 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
15878# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15879 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
15880# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15881 ! initialized to zero everywhere.
15882# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15883
15884# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15885 eps_mhd = patch_icpp(patch_id)%a(2)
15886# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15887 sigma = patch_icpp(patch_id)%a(3)
15888# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15889 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
15890# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15891
15892# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15893 ! B-field
15894# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15895 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
15896# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15897 case (261) ! Blob
15898# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15899 r0 = 1._wp/sqrt(8._wp)
15900# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15901 r2 = x_cc(i)**2 + y_cc(j)**2
15902# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15903 r = sqrt(r2)
15904# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15905 alpha = r/r0
15906# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15907 if (alpha < 1) then
15908# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15909 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)
15910# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15911 ! 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)
15912# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15913 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
15914# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15915 ! 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
15916# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15917 end if
15918# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15919 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
15920# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15921 ! rotate by \alpha = atan(2)
15922# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15923 alpha = atan(2._wp)
15924# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15925 cosa = cos(alpha)
15926# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15927 sina = sin(alpha)
15928# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15929 ! projection along shock normal
15930# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15931 r = x_cc(i)*cosa + y_cc(j)*sina
15932# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15933
15934# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15935 if (r <= 0.5_wp) then
15936# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15937 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
15938# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15939 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
15940# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15941 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
15942# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15943 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
15944# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15945 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
15946# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15947 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
15948# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15949 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
15950# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15951 else
15952# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15953 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
15954# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15955 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
15956# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15957 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
15958# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15959 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
15960# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15961 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
15962# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15963 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
15964# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15965 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
15966# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15967 end if
15968# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15969 ! v^z and B^z remain zero by default
15970# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15971 case (270) ! 2D extrusion of 1D profile from external data
15972# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15973 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
15974# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15975 if (.not. files_loaded) then
15976# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15977 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15978# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15979 do f = 1, max_files
15980# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15981 write (file_num_str, '(I0)') f
15982# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15983 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
15984# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15985 end do
15986# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15987
15988# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15989 ! Common file reading setup
15990# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15991 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15992# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15993 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
15994# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15995
15996# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15997 select case (num_dims)
15998# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15999 case (1, 2) ! 1D and 2D cases are similar
16000# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16001 ! Count lines
16002# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16003 line_count = 0
16004# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16005 do
16006# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16007 read (unit2, *, iostat=ios2) dummy_x, dummy_y
16008# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16009 if (ios2 /= 0) exit
16010# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16011 line_count = line_count + 1
16012# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16013 end do
16014# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16015 close (unit2)
16016# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16017
16018# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16019 xrows = line_count
16020# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16021 yrows = 1
16022# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16023 index_x = 0
16024# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16025 if (num_dims == 2) index_x = i
16026# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16027#ifdef MFC_DEBUG
16028# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16029 block
16030# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16031 use iso_fortran_env, only: output_unit
16032# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16033
16034# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16035 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
16036# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16037
16038# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16039 call flush (output_unit)
16040# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16041 end block
16042# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16043#endif
16044# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16045 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
16046# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16047
16048# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16049
16050# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16051
16052# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16053#if defined(MFC_OpenACC)
16054# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16055!$acc enter data create(x_coords, stored_values)
16056# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16057#elif defined(MFC_OpenMP)
16058# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16059!$omp target enter data map(always,alloc:x_coords, stored_values)
16060# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16061#endif
16062# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16063
16064# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16065 ! Read data from all files
16066# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16067 do f = 1, max_files
16068# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16069 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16070# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16071 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16072# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16073
16074# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16075 do iter = 1, xrows
16076# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16077 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
16078# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16079 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
16080# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16081 end do
16082# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16083 close (unit)
16084# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16085 end do
16086# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16087
16088# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16089 ! Calculate offsets
16090# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16091 domain_xstart = x_coords(1)
16092# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16093 x_step = x_cc(1) - x_cc(0)
16094# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16095 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
16096# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16097 global_offset_x = nint(abs(delta_x)/x_step)
16098# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16099 case (3) ! 3D case - determine grid structure
16100# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16101 ! Find yRows by counting rows with same x
16102# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16103 read (unit2, *, iostat=ios2) x0, y0, dummy_z
16104# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16105 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
16106# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16107
16108# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16109 yrows = 1
16110# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16111 do
16112# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16113 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16114# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16115 if (ios2 /= 0) exit
16116# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16117 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
16118# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16119 yrows = yrows + 1
16120# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16121 else
16122# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16123 exit
16124# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16125 end if
16126# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16127 end do
16128# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16129 close (unit2)
16130# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16131
16132# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16133 ! Count total rows
16134# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16135 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16136# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16137 nrows = 0
16138# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16139 do
16140# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16141 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16142# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16143 if (ios2 /= 0) exit
16144# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16145 nrows = nrows + 1
16146# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16147 end do
16148# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16149 close (unit2)
16150# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16151
16152# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16153 xrows = nrows/yrows
16154# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16155#ifdef MFC_DEBUG
16156# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16157 block
16158# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16159 use iso_fortran_env, only: output_unit
16160# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16161
16162# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16163 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
16164# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16165
16166# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16167 call flush (output_unit)
16168# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16169 end block
16170# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16171#endif
16172# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16173 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
16174# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16175
16176# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16177
16178# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16179
16180# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16181
16182# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16183#if defined(MFC_OpenACC)
16184# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16185!$acc enter data create(x_coords, y_coords, stored_values)
16186# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16187#elif defined(MFC_OpenMP)
16188# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16189!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
16190# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16191#endif
16192# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16193 index_x = i
16194# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16195 index_y = j
16196# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16197
16198# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16199 ! Read all files
16200# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16201 do f = 1, max_files
16202# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16203 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16204# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16205 if (ios /= 0) then
16206# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16207 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16208# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16209 cycle
16210# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16211 end if
16212# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16213
16214# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16215 iter = 0
16216# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16217 do iix = 1, xrows
16218# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16219 do iiy = 1, yrows
16220# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16221 iter = iter + 1
16222# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16223 if (f == 1) then
16224# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16225 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
16226# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16227 else
16228# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16229 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
16230# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16231 end if
16232# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16233 if (ios /= 0) call s_mpi_abort("Error reading data")
16234# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16235 end do
16236# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16237 end do
16238# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16239 close (unit)
16240# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16241 end do
16242# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16243
16244# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16245 ! Calculate offsets
16246# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16247 x_step = x_cc(1) - x_cc(0)
16248# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16249 y_step = y_cc(1) - y_cc(0)
16250# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16251 delta_x = x_cc(index_x) - x_coords(1)
16252# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16253 delta_y = y_cc(index_y) - y_coords(1)
16254# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16255 global_offset_x = nint(abs(delta_x)/x_step)
16256# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16257 global_offset_y = nint(abs(delta_y)/y_step)
16258# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16259 end select
16260# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16261
16262# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16263 files_loaded = .true.
16264# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16265 end if
16266# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16267
16268# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16269 ! Data assignment
16270# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16271 select case (num_dims)
16272# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16273 case (1)
16274# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16275 idx = i + 1 + global_offset_x
16276# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16277 ! idx must land inside the file's row range: this rank's subdomain offset
16278# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16279 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
16280# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16281 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
16282# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16283 if (idx < 1 .or. idx > xrows) &
16284# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16285 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16286# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16287 do f = 1, sys_size
16288# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16289 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
16290# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16291 end do
16292# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16293 case (2)
16294# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16295 idx = i + 1 + global_offset_x - index_x
16296# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16297 if (idx < 1 .or. idx > xrows) &
16298# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16299 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16300# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16301 do f = 1, sys_size - 1
16302# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16303 jump = merge(1, 0, f >= eqn_idx%mom%end)
16304# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16305 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
16306# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16307 end do
16308# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16309 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
16310# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16311 case (3)
16312# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16313 idx = i + 1 + global_offset_x - index_x
16314# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16315 idy = j + 1 + global_offset_y - index_y
16316# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16317 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
16318# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16319 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
16320# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16321 do f = 1, sys_size - 1
16322# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16323 jump = merge(1, 0, f >= eqn_idx%mom%end)
16324# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16325 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
16326# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16327 end do
16328# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16329 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
16330# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16331 end select
16332# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16333 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
16334# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16335 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
16336# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16337 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
16338# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16339 ! cross-stream-position profile (real cross-stream velocity is legitimately
16340# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16341 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
16342# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16343 ! zero out mom%beg's true physical value.
16344# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16345 if (.not. files_loaded) then
16346# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16347 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
16348# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16349 do f = 1, max_files
16350# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16351 write (file_num_str, '(I0)') f
16352# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16353 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
16354# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16355 end do
16356# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16357
16358# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16359 ! Common file reading setup
16360# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16361 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16362# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16363 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
16364# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16365
16366# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16367 select case (num_dims)
16368# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16369 case (1, 2) ! 1D and 2D cases are similar
16370# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16371 ! Count lines
16372# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16373 line_count = 0
16374# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16375 do
16376# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16377 read (unit2, *, iostat=ios2) dummy_x, dummy_y
16378# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16379 if (ios2 /= 0) exit
16380# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16381 line_count = line_count + 1
16382# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16383 end do
16384# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16385 close (unit2)
16386# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16387
16388# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16389 xrows = line_count
16390# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16391 yrows = 1
16392# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16393 index_x = 0
16394# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16395 if (num_dims == 2) index_x = i
16396# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16397#ifdef MFC_DEBUG
16398# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16399 block
16400# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16401 use iso_fortran_env, only: output_unit
16402# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16403
16404# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16405 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
16406# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16407
16408# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16409 call flush (output_unit)
16410# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16411 end block
16412# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16413#endif
16414# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16415 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
16416# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16417
16418# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16419
16420# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16421
16422# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16423#if defined(MFC_OpenACC)
16424# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16425!$acc enter data create(x_coords, stored_values)
16426# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16427#elif defined(MFC_OpenMP)
16428# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16429!$omp target enter data map(always,alloc:x_coords, stored_values)
16430# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16431#endif
16432# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16433
16434# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16435 ! Read data from all files
16436# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16437 do f = 1, max_files
16438# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16439 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16440# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16441 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16442# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16443
16444# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16445 do iter = 1, xrows
16446# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16447 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
16448# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16449 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
16450# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16451 end do
16452# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16453 close (unit)
16454# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16455 end do
16456# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16457
16458# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16459 ! Calculate offsets
16460# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16461 domain_xstart = x_coords(1)
16462# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16463 x_step = x_cc(1) - x_cc(0)
16464# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16465 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
16466# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16467 global_offset_x = nint(abs(delta_x)/x_step)
16468# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16469 case (3) ! 3D case - determine grid structure
16470# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16471 ! Find yRows by counting rows with same x
16472# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16473 read (unit2, *, iostat=ios2) x0, y0, dummy_z
16474# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16475 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
16476# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16477
16478# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16479 yrows = 1
16480# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16481 do
16482# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16483 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16484# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16485 if (ios2 /= 0) exit
16486# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16487 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
16488# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16489 yrows = yrows + 1
16490# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16491 else
16492# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16493 exit
16494# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16495 end if
16496# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16497 end do
16498# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16499 close (unit2)
16500# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16501
16502# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16503 ! Count total rows
16504# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16505 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16506# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16507 nrows = 0
16508# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16509 do
16510# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16511 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16512# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16513 if (ios2 /= 0) exit
16514# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16515 nrows = nrows + 1
16516# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16517 end do
16518# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16519 close (unit2)
16520# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16521
16522# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16523 xrows = nrows/yrows
16524# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16525#ifdef MFC_DEBUG
16526# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16527 block
16528# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16529 use iso_fortran_env, only: output_unit
16530# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16531
16532# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16533 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
16534# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16535
16536# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16537 call flush (output_unit)
16538# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16539 end block
16540# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16541#endif
16542# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16543 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
16544# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16545
16546# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16547
16548# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16549
16550# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16551
16552# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16553#if defined(MFC_OpenACC)
16554# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16555!$acc enter data create(x_coords, y_coords, stored_values)
16556# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16557#elif defined(MFC_OpenMP)
16558# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16559!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
16560# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16561#endif
16562# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16563 index_x = i
16564# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16565 index_y = j
16566# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16567
16568# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16569 ! Read all files
16570# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16571 do f = 1, max_files
16572# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16573 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16574# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16575 if (ios /= 0) then
16576# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16577 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16578# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16579 cycle
16580# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16581 end if
16582# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16583
16584# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16585 iter = 0
16586# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16587 do iix = 1, xrows
16588# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16589 do iiy = 1, yrows
16590# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16591 iter = iter + 1
16592# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16593 if (f == 1) then
16594# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16595 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
16596# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16597 else
16598# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16599 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
16600# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16601 end if
16602# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16603 if (ios /= 0) call s_mpi_abort("Error reading data")
16604# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16605 end do
16606# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16607 end do
16608# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16609 close (unit)
16610# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16611 end do
16612# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16613
16614# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16615 ! Calculate offsets
16616# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16617 x_step = x_cc(1) - x_cc(0)
16618# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16619 y_step = y_cc(1) - y_cc(0)
16620# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16621 delta_x = x_cc(index_x) - x_coords(1)
16622# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16623 delta_y = y_cc(index_y) - y_coords(1)
16624# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16625 global_offset_x = nint(abs(delta_x)/x_step)
16626# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16627 global_offset_y = nint(abs(delta_y)/y_step)
16628# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16629 end select
16630# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16631
16632# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16633 files_loaded = .true.
16634# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16635 end if
16636# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16637
16638# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16639 ! Data assignment
16640# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16641 select case (num_dims)
16642# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16643 case (1)
16644# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16645 idx = i + 1 + global_offset_x
16646# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16647 ! idx must land inside the file's row range: this rank's subdomain offset
16648# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16649 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
16650# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16651 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
16652# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16653 if (idx < 1 .or. idx > xrows) &
16654# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16655 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16656# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16657 do f = 1, sys_size
16658# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16659 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
16660# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16661 end do
16662# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16663 case (2)
16664# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16665 idx = i + 1 + global_offset_x - index_x
16666# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16667 if (idx < 1 .or. idx > xrows) &
16668# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16669 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16670# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16671 do f = 1, sys_size - 1
16672# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16673 jump = merge(1, 0, f >= eqn_idx%mom%end)
16674# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16675 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
16676# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16677 end do
16678# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16679 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
16680# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16681 case (3)
16682# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16683 idx = i + 1 + global_offset_x - index_x
16684# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16685 idy = j + 1 + global_offset_y - index_y
16686# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16687 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
16688# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16689 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
16690# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16691 do f = 1, sys_size - 1
16692# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16693 jump = merge(1, 0, f >= eqn_idx%mom%end)
16694# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16695 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
16696# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16697 end do
16698# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16699 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
16700# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16701 end select
16702# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16703 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
16704# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16705 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
16706# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16707 case (274) ! Full 2D field from external data (no extrusion)
16708# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16709 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
16710# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16711 ! extrusion direction and no zeroed component -- all sys_size variables are read and
16712# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16713 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
16714# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16715 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
16716# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16717 ! global grid exactly -- by construction, since the IC generator derives both the
16718# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16719 ! grid and the file contents from the same computation.
16720# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16721 !
16722# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16723 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
16724# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16725 ! file's own first coordinate and this rank's uniform grid spacing -- following the
16726# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16727 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
16728# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16729 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
16730# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16731 ! returns before allocating it otherwise), so a serial-IO run (the default for
16732# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16733 ! golden-file tests) would index into an unallocated array.
16734# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16735 !
16736# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16737 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
16738# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16739 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
16740# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16741 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
16742# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16743 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
16744# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16745 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
16746# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16747 ! global cell offset) are pinned from f274==1's very first record, before any other
16748# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16749 ! record is read, so every subsequent record -- across all variables -- can be tested
16750# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16751 ! against this rank's range and dropped if it falls outside it.
16752# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16753 x_step274 = x_cc(1) - x_cc(0)
16754# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16755 y_step274 = y_cc(1) - y_cc(0)
16756# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16757
16758# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16759 if (.not. files_loaded274) then
16760# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16761#ifdef MFC_DEBUG
16762# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16763 block
16764# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16765 use iso_fortran_env, only: output_unit
16766# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16767
16768# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16769 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
16770# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16771
16772# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16773 call flush (output_unit)
16774# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16775 end block
16776# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16777#endif
16778# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16779 allocate (stored_values274(0:m, 0:n, sys_size))
16780# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16781
16782# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16783
16784# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16785#if defined(MFC_OpenACC)
16786# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16787!$acc enter data create(stored_values274)
16788# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16789#elif defined(MFC_OpenMP)
16790# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16791!$omp target enter data map(always,alloc:stored_values274)
16792# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16793#endif
16794# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16795 do f274 = 1, sys_size
16796# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16797 write (file_num_str274, '(I0)') f274
16798# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16799 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
16800# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16801 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
16802# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16803 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
16804# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16805 do ix274 = 0, m_glb
16806# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16807 do iy274 = 0, n_glb
16808# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16809 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
16810# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16811 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
16812# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16813 ! Capture the file's own origin and spacing from its first records so we can
16814# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16815 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
16816# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16817 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
16818# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16819 if (f274 == 1) then
16820# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16821 if (ix274 == 0 .and. iy274 == 0) then
16822# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16823 x0_274 = dummy_x274
16824# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16825 y0_274 = dummy_y274
16826# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16827 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
16828# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16829 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
16830# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16831 end if
16832# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16833 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
16834# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16835 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
16836# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16837 end if
16838# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16839 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
16840# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16841 & .and. iy274 - local_iy_beg274 <= n) then
16842# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16843 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
16844# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16845 end if
16846# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16847 end do
16848# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16849 end do
16850# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16851 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
16852# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16853 ! read means it was generated for a larger grid and would be silently misread.
16854# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16855 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
16856# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16857 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
16858# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16859 close (unit274)
16860# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16861 end do
16862# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16863
16864# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16865 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
16866# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16867 ! Check alignment via the integer cell offset of this rank's first cell from the file
16868# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16869 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
16870# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16871 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
16872# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16873 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
16874# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16875 ! the global origin.) The spacing checks below must also hold.
16876# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16877 r_align274 = (x_cc(0) - x0_274)/x_step274
16878# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16879 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
16880# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16881 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
16882# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16883 if (m_glb >= 1) then
16884# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16885 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
16886# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16887 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
16888# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16889 end if
16890# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16891 if (n_glb >= 1) then
16892# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16893 r_align274 = (y_cc(0) - y0_274)/y_step274
16894# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16895 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
16896# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16897 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
16898# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16899 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
16900# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16901 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
16902# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16903 end if
16904# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16905
16906# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16907 files_loaded274 = .true.
16908# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16909 end if
16910# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16911 ! Alignment is verified above (or this rank would already have aborted), so the local
16912# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16913 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
16914# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16915 do f274 = 1, sys_size
16916# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16917 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
16918# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16919 end do
16920# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16921 case (271) ! Premixed Flame Vortices Interaction
16922# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16923 if (.not. files_loaded) then
16924# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16925 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
16926# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16927 do f = 1, max_files
16928# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16929 write (file_num_str, '(I0)') f
16930# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16931 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
16932# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16933 end do
16934# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16935
16936# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16937 ! Common file reading setup
16938# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16939 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16940# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16941 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
16942# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16943
16944# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16945 select case (num_dims)
16946# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16947 case (1, 2) ! 1D and 2D cases are similar
16948# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16949 ! Count lines
16950# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16951 line_count = 0
16952# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16953 do
16954# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16955 read (unit2, *, iostat=ios2) dummy_x, dummy_y
16956# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16957 if (ios2 /= 0) exit
16958# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16959 line_count = line_count + 1
16960# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16961 end do
16962# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16963 close (unit2)
16964# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16965
16966# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16967 xrows = line_count
16968# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16969 yrows = 1
16970# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16971 index_x = 0
16972# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16973 if (num_dims == 2) index_x = i
16974# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16975#ifdef MFC_DEBUG
16976# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16977 block
16978# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16979 use iso_fortran_env, only: output_unit
16980# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16981
16982# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16983 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
16984# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16985
16986# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16987 call flush (output_unit)
16988# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16989 end block
16990# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16991#endif
16992# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16993 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
16994# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16995
16996# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16997
16998# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16999
17000# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17001#if defined(MFC_OpenACC)
17002# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17003!$acc enter data create(x_coords, stored_values)
17004# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17005#elif defined(MFC_OpenMP)
17006# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17007!$omp target enter data map(always,alloc:x_coords, stored_values)
17008# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17009#endif
17010# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17011
17012# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17013 ! Read data from all files
17014# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17015 do f = 1, max_files
17016# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17017 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17018# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17019 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17020# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17021
17022# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17023 do iter = 1, xrows
17024# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17025 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
17026# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17027 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
17028# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17029 end do
17030# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17031 close (unit)
17032# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17033 end do
17034# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17035
17036# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17037 ! Calculate offsets
17038# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17039 domain_xstart = x_coords(1)
17040# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17041 x_step = x_cc(1) - x_cc(0)
17042# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17043 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
17044# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17045 global_offset_x = nint(abs(delta_x)/x_step)
17046# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17047 case (3) ! 3D case - determine grid structure
17048# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17049 ! Find yRows by counting rows with same x
17050# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17051 read (unit2, *, iostat=ios2) x0, y0, dummy_z
17052# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17053 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
17054# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17055
17056# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17057 yrows = 1
17058# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17059 do
17060# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17061 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17062# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17063 if (ios2 /= 0) exit
17064# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17065 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
17066# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17067 yrows = yrows + 1
17068# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17069 else
17070# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17071 exit
17072# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17073 end if
17074# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17075 end do
17076# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17077 close (unit2)
17078# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17079
17080# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17081 ! Count total rows
17082# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17083 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17084# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17085 nrows = 0
17086# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17087 do
17088# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17089 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17090# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17091 if (ios2 /= 0) exit
17092# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17093 nrows = nrows + 1
17094# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17095 end do
17096# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17097 close (unit2)
17098# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17099
17100# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17101 xrows = nrows/yrows
17102# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17103#ifdef MFC_DEBUG
17104# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17105 block
17106# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17107 use iso_fortran_env, only: output_unit
17108# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17109
17110# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17111 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
17112# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17113
17114# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17115 call flush (output_unit)
17116# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17117 end block
17118# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17119#endif
17120# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17121 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
17122# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17123
17124# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17125
17126# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17127
17128# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17129
17130# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17131#if defined(MFC_OpenACC)
17132# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17133!$acc enter data create(x_coords, y_coords, stored_values)
17134# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17135#elif defined(MFC_OpenMP)
17136# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17137!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
17138# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17139#endif
17140# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17141 index_x = i
17142# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17143 index_y = j
17144# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17145
17146# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17147 ! Read all files
17148# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17149 do f = 1, max_files
17150# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17151 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17152# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17153 if (ios /= 0) then
17154# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17155 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17156# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17157 cycle
17158# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17159 end if
17160# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17161
17162# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17163 iter = 0
17164# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17165 do iix = 1, xrows
17166# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17167 do iiy = 1, yrows
17168# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17169 iter = iter + 1
17170# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17171 if (f == 1) then
17172# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17173 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
17174# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17175 else
17176# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17177 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
17178# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17179 end if
17180# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17181 if (ios /= 0) call s_mpi_abort("Error reading data")
17182# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17183 end do
17184# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17185 end do
17186# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17187 close (unit)
17188# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17189 end do
17190# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17191
17192# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17193 ! Calculate offsets
17194# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17195 x_step = x_cc(1) - x_cc(0)
17196# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17197 y_step = y_cc(1) - y_cc(0)
17198# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17199 delta_x = x_cc(index_x) - x_coords(1)
17200# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17201 delta_y = y_cc(index_y) - y_coords(1)
17202# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17203 global_offset_x = nint(abs(delta_x)/x_step)
17204# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17205 global_offset_y = nint(abs(delta_y)/y_step)
17206# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17207 end select
17208# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17209
17210# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17211 files_loaded = .true.
17212# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17213 end if
17214# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17215
17216# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17217 ! Data assignment
17218# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17219 select case (num_dims)
17220# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17221 case (1)
17222# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17223 idx = i + 1 + global_offset_x
17224# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17225 ! idx must land inside the file's row range: this rank's subdomain offset
17226# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17227 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
17228# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17229 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
17230# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17231 if (idx < 1 .or. idx > xrows) &
17232# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17233 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17234# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17235 do f = 1, sys_size
17236# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17237 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
17238# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17239 end do
17240# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17241 case (2)
17242# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17243 idx = i + 1 + global_offset_x - index_x
17244# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17245 if (idx < 1 .or. idx > xrows) &
17246# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17247 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17248# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17249 do f = 1, sys_size - 1
17250# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17251 jump = merge(1, 0, f >= eqn_idx%mom%end)
17252# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17253 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
17254# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17255 end do
17256# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17257 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17258# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17259 case (3)
17260# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17261 idx = i + 1 + global_offset_x - index_x
17262# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17263 idy = j + 1 + global_offset_y - index_y
17264# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17265 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
17266# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17267 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
17268# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17269 do f = 1, sys_size - 1
17270# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17271 jump = merge(1, 0, f >= eqn_idx%mom%end)
17272# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17273 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
17274# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17275 end do
17276# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17277 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
17278# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17279 end select
17280# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17281 x1c = 0.0027_wp
17282# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17283 y1c = 0.005_wp
17284# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17285 x2c = 0.0027_wp
17286# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17287 y2c = 0.003_wp
17288# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17289 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
17290# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17291 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
17292# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17293 rvortex = 0.0005_wp
17294# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17295 cvortex = 6000.0_wp
17296# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17297
17298# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17299 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
17300# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17301 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
17302# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17303
17304# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17305 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
17306# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17307 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
17308# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17309 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
17310# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17311 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
17312# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17313 case (272) ! Premixed Flame Instability
17314# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17315 if (.not. files_loaded) then
17316# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17317 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
17318# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17319 do f = 1, max_files
17320# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17321 write (file_num_str, '(I0)') f
17322# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17323 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
17324# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17325 end do
17326# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17327
17328# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17329 ! Common file reading setup
17330# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17331 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17332# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17333 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
17334# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17335
17336# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17337 select case (num_dims)
17338# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17339 case (1, 2) ! 1D and 2D cases are similar
17340# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17341 ! Count lines
17342# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17343 line_count = 0
17344# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17345 do
17346# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17347 read (unit2, *, iostat=ios2) dummy_x, dummy_y
17348# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17349 if (ios2 /= 0) exit
17350# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17351 line_count = line_count + 1
17352# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17353 end do
17354# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17355 close (unit2)
17356# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17357
17358# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17359 xrows = line_count
17360# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17361 yrows = 1
17362# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17363 index_x = 0
17364# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17365 if (num_dims == 2) index_x = i
17366# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17367#ifdef MFC_DEBUG
17368# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17369 block
17370# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17371 use iso_fortran_env, only: output_unit
17372# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17373
17374# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17375 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
17376# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17377
17378# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17379 call flush (output_unit)
17380# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17381 end block
17382# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17383#endif
17384# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17385 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
17386# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17387
17388# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17389
17390# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17391
17392# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17393#if defined(MFC_OpenACC)
17394# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17395!$acc enter data create(x_coords, stored_values)
17396# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17397#elif defined(MFC_OpenMP)
17398# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17399!$omp target enter data map(always,alloc:x_coords, stored_values)
17400# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17401#endif
17402# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17403
17404# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17405 ! Read data from all files
17406# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17407 do f = 1, max_files
17408# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17409 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17410# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17411 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17412# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17413
17414# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17415 do iter = 1, xrows
17416# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17417 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
17418# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17419 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
17420# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17421 end do
17422# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17423 close (unit)
17424# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17425 end do
17426# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17427
17428# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17429 ! Calculate offsets
17430# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17431 domain_xstart = x_coords(1)
17432# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17433 x_step = x_cc(1) - x_cc(0)
17434# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17435 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
17436# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17437 global_offset_x = nint(abs(delta_x)/x_step)
17438# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17439 case (3) ! 3D case - determine grid structure
17440# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17441 ! Find yRows by counting rows with same x
17442# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17443 read (unit2, *, iostat=ios2) x0, y0, dummy_z
17444# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17445 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
17446# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17447
17448# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17449 yrows = 1
17450# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17451 do
17452# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17453 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17454# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17455 if (ios2 /= 0) exit
17456# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17457 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
17458# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17459 yrows = yrows + 1
17460# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17461 else
17462# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17463 exit
17464# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17465 end if
17466# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17467 end do
17468# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17469 close (unit2)
17470# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17471
17472# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17473 ! Count total rows
17474# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17475 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17476# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17477 nrows = 0
17478# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17479 do
17480# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17481 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17482# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17483 if (ios2 /= 0) exit
17484# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17485 nrows = nrows + 1
17486# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17487 end do
17488# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17489 close (unit2)
17490# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17491
17492# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17493 xrows = nrows/yrows
17494# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17495#ifdef MFC_DEBUG
17496# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17497 block
17498# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17499 use iso_fortran_env, only: output_unit
17500# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17501
17502# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17503 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
17504# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17505
17506# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17507 call flush (output_unit)
17508# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17509 end block
17510# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17511#endif
17512# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17513 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
17514# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17515
17516# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17517
17518# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17519
17520# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17521
17522# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17523#if defined(MFC_OpenACC)
17524# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17525!$acc enter data create(x_coords, y_coords, stored_values)
17526# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17527#elif defined(MFC_OpenMP)
17528# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17529!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
17530# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17531#endif
17532# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17533 index_x = i
17534# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17535 index_y = j
17536# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17537
17538# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17539 ! Read all files
17540# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17541 do f = 1, max_files
17542# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17543 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17544# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17545 if (ios /= 0) then
17546# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17547 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17548# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17549 cycle
17550# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17551 end if
17552# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17553
17554# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17555 iter = 0
17556# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17557 do iix = 1, xrows
17558# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17559 do iiy = 1, yrows
17560# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17561 iter = iter + 1
17562# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17563 if (f == 1) then
17564# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17565 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
17566# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17567 else
17568# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17569 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
17570# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17571 end if
17572# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17573 if (ios /= 0) call s_mpi_abort("Error reading data")
17574# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17575 end do
17576# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17577 end do
17578# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17579 close (unit)
17580# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17581 end do
17582# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17583
17584# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17585 ! Calculate offsets
17586# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17587 x_step = x_cc(1) - x_cc(0)
17588# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17589 y_step = y_cc(1) - y_cc(0)
17590# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17591 delta_x = x_cc(index_x) - x_coords(1)
17592# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17593 delta_y = y_cc(index_y) - y_coords(1)
17594# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17595 global_offset_x = nint(abs(delta_x)/x_step)
17596# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17597 global_offset_y = nint(abs(delta_y)/y_step)
17598# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17599 end select
17600# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17601
17602# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17603 files_loaded = .true.
17604# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17605 end if
17606# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17607
17608# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17609 ! Data assignment
17610# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17611 select case (num_dims)
17612# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17613 case (1)
17614# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17615 idx = i + 1 + global_offset_x
17616# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17617 ! idx must land inside the file's row range: this rank's subdomain offset
17618# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17619 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
17620# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17621 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
17622# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17623 if (idx < 1 .or. idx > xrows) &
17624# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17625 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17626# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17627 do f = 1, sys_size
17628# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17629 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
17630# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17631 end do
17632# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17633 case (2)
17634# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17635 idx = i + 1 + global_offset_x - index_x
17636# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17637 if (idx < 1 .or. idx > xrows) &
17638# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17639 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17640# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17641 do f = 1, sys_size - 1
17642# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17643 jump = merge(1, 0, f >= eqn_idx%mom%end)
17644# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17645 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
17646# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17647 end do
17648# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17649 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17650# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17651 case (3)
17652# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17653 idx = i + 1 + global_offset_x - index_x
17654# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17655 idy = j + 1 + global_offset_y - index_y
17656# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17657 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
17658# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17659 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
17660# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17661 do f = 1, sys_size - 1
17662# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17663 jump = merge(1, 0, f >= eqn_idx%mom%end)
17664# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17665 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
17666# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17667 end do
17668# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17669 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
17670# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17671 end select
17672# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17673
17674# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17675 y_center = y0_ref
17676# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17677 y_dist = y_cc(j) - y_center
17678# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17679 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
17680# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17681 front_shift = a_param*sin(wave_phase)
17682# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17683
17684# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17685 x_mapped = x_cc(i) - front_shift
17686# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17687
17688# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17689 if (x_mapped <= x_coords(1)) then
17690# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17691 do v = 1, sys_size - 1
17692# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17693 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
17694# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17695 end do
17696# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17697 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17698# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17699 else if (x_mapped >= x_coords(xrows)) then
17700# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17701 do v = 1, sys_size - 1
17702# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17703 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
17704# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17705 end do
17706# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17707 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17708# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17709 else
17710# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17711 idx_lo = 1; idx_hi = xrows
17712# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17713 do while (idx_hi - idx_lo > 1)
17714# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17715 idx_mid = (idx_lo + idx_hi)/2
17716# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17717 if (x_coords(idx_mid) <= x_mapped) then
17718# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17719 idx_lo = idx_mid
17720# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17721 else
17722# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17723 idx_hi = idx_mid
17724# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17725 end if
17726# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17727 end do
17728# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17729
17730# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17731 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
17732# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17733
17734# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17735 do v = 1, sys_size - 1
17736# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17737 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
17738# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17739 & v) + interp_wt*stored_values(idx_hi, 1, v)
17740# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17741 end do
17742# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17743 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17744# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17745 end if
17746# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17747 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
17748# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17749 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
17750# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17751 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
17752# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17753 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
17754# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17755 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
17756# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17757 & - y_domain%beg))
17758# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17759 if (x_cc(i) > d) then
17760# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17761 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
17762# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17763 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
17764# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17765 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
17766# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17767 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
17768# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17769 do v = eqn_idx%species%beg, eqn_idx%species%end
17770# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17771 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
17772# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17773 end do
17774# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17775 end if
17776# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17777 case (280) ! Isentropic vortex
17778# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17779 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
17780# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17781 ! geometry 2
17782# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17783 if (patch_id == 1) then
17784# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17785 q_prim_vf(eqn_idx%E)%sf(i, j, &
17786# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17787 & 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) &
17788# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17789 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
17790# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17791 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
17792# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17793 & 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) &
17794# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17795 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
17796# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17797 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
17798# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17799 & 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) &
17800# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17801 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
17802# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17803 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
17804# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17805 & 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) &
17806# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17807 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
17808# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17809 end if
17810# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17811 case (281) ! Acoustic pulse
17812# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17813 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
17814# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17815 ! geometry 2
17816# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17817 if (patch_id == 2) then
17818# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17819 q_prim_vf(eqn_idx%E)%sf(i, j, &
17820# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17821 & 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))
17822# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17823 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
17824# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17825 & 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))
17826# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17827 end if
17828# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17829 case (282) ! Zero-circulation vortex
17830# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17831 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
17832# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17833 ! geometry 2
17834# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17835 if (patch_id == 2) then
17836# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17837 q_prim_vf(eqn_idx%E)%sf(i, j, &
17838# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17839 & 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))
17840# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17841 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
17842# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17843 & 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))
17844# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17845 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
17846# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17847 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
17848# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17849 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
17850# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17851 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
17852# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17853 end if
17854# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17855 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
17856# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17857 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
17858# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17859 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
17860# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17861 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
17862# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17863 ! patch_icpp(patch_id)%epsilon; defaults to 5.
17864# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17865 if (patch_id == 1) then
17866# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17867 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
17868# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17869 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
17870# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17871 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
17872# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17873 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
17874# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17875 do igq = 1, 3
17876# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17877 do jgq = 1, 3
17878# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17879 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
17880# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17881 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
17882# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17883 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
17884# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17885 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))
17886# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17887 wq = gauss_w(igq)*gauss_w(jgq)
17888# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17889 rhoq = t_facq**1.4_wp
17890# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17891 pq = t_facq**2.4_wp
17892# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17893 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
17894# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17895 & - r2q)
17896# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17897 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
17898# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17899 & - r2q)
17900# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17901 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
17902# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17903 rho_avg = rho_avg + wq*rhoq
17904# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17905 rhou_avg = rhou_avg + wq*(rhoq*uq)
17906# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17907 rhov_avg = rhov_avg + wq*(rhoq*vq)
17908# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17909 e_avg = e_avg + wq*eq
17910# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17911 end do
17912# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17913 end do
17914# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17915 rho_avg = rho_avg*0.25_wp
17916# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17917 rhou_avg = rhou_avg*0.25_wp
17918# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17919 rhov_avg = rhov_avg*0.25_wp
17920# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17921 e_avg = e_avg*0.25_wp
17922# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17923 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
17924# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17925 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
17926# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17927 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
17928# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17929 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
17930# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17931 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
17932# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17933 end if
17934# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17935 case (291) ! Isothermal Flat Plate
17936# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17937 t_inf = 1125.0_wp
17938# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17939 t_wall = 600.0_wp
17940# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17941 p_atm = 101325.0_wp
17942# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17943
17944# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17945 ! Boundary/Shear Layer thicknesses
17946# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17947 delta_th = 0.0003_wp ! Thermal BL thickness
17948# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17949 delta_shear = 8e-3_wp ! Velocity BL thickness
17950# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17951
17952# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17953 u_max = 50.0_wp ! Freestream Velocity (m/s)
17954# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17955
17956# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17957 mw_n2 = 28.0134e-3_wp
17958# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17959 mw_o2 = 31.999e-3_wp
17960# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17961 y_n2 = 0.767_wp
17962# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17963 y_o2 = 0.233_wp
17964# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17965 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
17966# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17967 bottom_blend_u = tanh(y_cc(j)/delta_shear)
17968# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17969 bottom_blend_t = tanh(y_cc(j)/delta_th)
17970# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17971 u_mean = u_max*bottom_blend_u
17972# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17973 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
17974# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17975 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
17976# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17977 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
17978# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17979 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17980# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17981 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
17982# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17983 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
17984# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17985 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
17986# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17987 case default
17988# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17989 if (proc_rank == 0) then
17990# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17991 call s_int_to_str(patch_id, istr)
17992# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17993 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
17994# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17995 end if
17996# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17997 end select
17998 end if
17999
18000 ! Updating the patch identities bookkeeping variable
18001 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
18002 end if
18003 end if
18004 end do
18005 end do
18006 if (allocated(stored_values)) then
18007# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18008#ifdef MFC_DEBUG
18009# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18010 block
18011# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18012 use iso_fortran_env, only: output_unit
18013# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18014
18015# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18016 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(stored_values)'
18017# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18018
18019# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18020 call flush (output_unit)
18021# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18022 end block
18023# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18024#endif
18025# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18026
18027# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18028#if defined(MFC_OpenACC)
18029# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18030!$acc exit data delete(stored_values)
18031# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18032#elif defined(MFC_OpenMP)
18033# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18034!$omp target exit data map(release:stored_values)
18035# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18036#endif
18037# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18038 deallocate (stored_values)
18039# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18040#ifdef MFC_DEBUG
18041# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18042 block
18043# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18044 use iso_fortran_env, only: output_unit
18045# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18046
18047# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18048 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(x_coords)'
18049# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18050
18051# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18052 call flush (output_unit)
18053# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18054 end block
18055# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18056#endif
18057# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18058
18059# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18060#if defined(MFC_OpenACC)
18061# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18062!$acc exit data delete(x_coords)
18063# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18064#elif defined(MFC_OpenMP)
18065# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18066!$omp target exit data map(release:x_coords)
18067# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18068#endif
18069# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18070 deallocate (x_coords)
18071# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18072 end if
18073# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18074
18075# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18076 if (allocated(y_coords)) then
18077# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18078#ifdef MFC_DEBUG
18079# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18080 block
18081# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18082 use iso_fortran_env, only: output_unit
18083# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18084
18085# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18086 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(y_coords)'
18087# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18088
18089# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18090 call flush (output_unit)
18091# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18092 end block
18093# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18094#endif
18095# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18096
18097# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18098#if defined(MFC_OpenACC)
18099# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18100!$acc exit data delete(y_coords)
18101# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18102#elif defined(MFC_OpenMP)
18103# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18104!$omp target exit data map(release:y_coords)
18105# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18106#endif
18107# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18108 deallocate (y_coords)
18109# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18110 end if
18111# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18112
18113# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18114 files_loaded = .false.
18115# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18116
18117# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18118 if (allocated(stored_values274)) then
18119# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18120#ifdef MFC_DEBUG
18121# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18122 block
18123# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18124 use iso_fortran_env, only: output_unit
18125# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18126
18127# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18128 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(stored_values274)'
18129# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18130
18131# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18132 call flush (output_unit)
18133# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18134 end block
18135# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18136#endif
18137# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18138
18139# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18140#if defined(MFC_OpenACC)
18141# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18142!$acc exit data delete(stored_values274)
18143# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18144#elif defined(MFC_OpenMP)
18145# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18146!$omp target exit data map(release:stored_values274)
18147# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18148#endif
18149# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18150 deallocate (stored_values274)
18151# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18152 end if
18153# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18154
18155# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18156 files_loaded274 = .false.
18157
18158 end subroutine s_icpp_rectangle
18159
18160 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
18161 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
18162 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
18163 !! the smoothing of its boundary.
18164 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
18165
18166 integer, intent(in) :: patch_id
18167
18168#ifdef MFC_MIXED_PRECISION
18169 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
18170#else
18171 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
18172#endif
18173 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
18174 integer :: i, j, k !< Generic loop operators
18175 real(wp) :: a, b, c
18176
18177 integer :: xRows, yRows, nRows, iix, iiy, max_files
18178# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18179 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
18180# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18181 real(wp) :: x_step, y_step
18182# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18183 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
18184# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18185 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
18186# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18187 real(wp) :: delta_x, delta_y
18188# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18189 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
18190# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18191 real(wp), allocatable :: stored_values(:,:,:)
18192# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18193 real(wp), allocatable :: x_coords(:), y_coords(:)
18194# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18195 logical :: files_loaded = .false.
18196# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18197 real(wp) :: domain_xstart
18198# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18199 character(len=20) :: file_num_str !< For storing the file number as a string
18200# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18201 integer :: ios
18202# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18203 integer :: ios2
18204# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18205
18206# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18207 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
18208# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18209 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
18210# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18211 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
18212# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18213 ! y_coords/files_loaded above.
18214# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18215 real(wp), allocatable, dimension(:,:,:) :: stored_values274
18216# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18217 logical :: files_loaded274 = .false.
18218# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18219 integer :: f274, ix274, iy274, unit274, ios274
18220# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18221 integer :: local_ix_beg274, local_iy_beg274
18222# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18223 character(len=300) :: fname274
18224# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18225 character(len=20) :: file_num_str274
18226# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18227 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
18228# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18229 real(wp) :: file_dx274, file_dy274, r_align274
18230 ! Place any declaration of intermediate variables here
18231# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18232 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
18233# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18234 real(wp) :: eps
18235# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18236
18237# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18238 ! IGR Jets Arrays to stor position and radii of jets from input file
18239# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18240 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
18241# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18242 ! Variables to describe initial condition of jet
18243# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18244 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
18245# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18246 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
18247# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18248 real(wp), dimension(0:n,0:p) :: rcut_arr
18249# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18250 integer :: l, q, s !< Iterators for reading input files
18251# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18252 integer :: start, end !< Ints to keep track of position in file
18253# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18254 character(len=100000) :: line ! String to store line in file
18255# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18256 character(len=25) :: value !< String to store value in line
18257# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18258 integer :: NJet !< Number of jets
18259# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18260 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
18261# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18262 logical :: file_exist ! Flag to check if file exists
18263# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18264
18265# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18266 eps = 1e-9_wp
18267# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18268
18269# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18270 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
18271# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18272 eps_smooth = 3._wp
18273# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18274 inquire (file="njet.txt", exist=file_exist)
18275# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18276 if (file_exist) then
18277# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18278 open (unit=10, file="njet.txt", status="old", action="read")
18279# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18280 read (10, *) njet
18281# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18282 close (10)
18283# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18284 else
18285# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18286 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
18287# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18288 end if
18289# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18290
18291# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18292#ifdef MFC_DEBUG
18293# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18294 block
18295# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18296 use iso_fortran_env, only: output_unit
18297# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18298
18299# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18300 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
18301# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18302
18303# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18304 call flush (output_unit)
18305# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18306 end block
18307# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18308#endif
18309# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18310 allocate (y_th_arr(0:njet - 1))
18311# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18312
18313# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18314
18315# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18316#if defined(MFC_OpenACC)
18317# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18318!$acc enter data create(y_th_arr)
18319# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18320#elif defined(MFC_OpenMP)
18321# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18322!$omp target enter data map(always,alloc:y_th_arr)
18323# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18324#endif
18325# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18326#ifdef MFC_DEBUG
18327# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18328 block
18329# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18330 use iso_fortran_env, only: output_unit
18331# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18332
18333# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18334 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
18335# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18336
18337# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18338 call flush (output_unit)
18339# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18340 end block
18341# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18342#endif
18343# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18344 allocate (z_th_arr(0:njet - 1))
18345# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18346
18347# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18348
18349# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18350#if defined(MFC_OpenACC)
18351# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18352!$acc enter data create(z_th_arr)
18353# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18354#elif defined(MFC_OpenMP)
18355# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18356!$omp target enter data map(always,alloc:z_th_arr)
18357# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18358#endif
18359# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18360#ifdef MFC_DEBUG
18361# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18362 block
18363# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18364 use iso_fortran_env, only: output_unit
18365# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18366
18367# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18368 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
18369# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18370
18371# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18372 call flush (output_unit)
18373# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18374 end block
18375# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18376#endif
18377# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18378 allocate (r_th_arr(0:njet - 1))
18379# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18380
18381# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18382
18383# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18384#if defined(MFC_OpenACC)
18385# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18386!$acc enter data create(r_th_arr)
18387# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18388#elif defined(MFC_OpenMP)
18389# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18390!$omp target enter data map(always,alloc:r_th_arr)
18391# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18392#endif
18393# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18394
18395# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18396 inquire (file="jets.csv", exist=file_exist)
18397# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18398 if (file_exist) then
18399# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18400 open (unit=10, file="jets.csv", status="old", action="read")
18401# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18402 do q = 0, njet - 1
18403# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18404 read (10, '(A)') line ! Read a full line as a string
18405# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18406 start = 1
18407# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18408
18409# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18410 do l = 0, 2
18411# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18412 end = index(line(start:), ',') ! Find the next comma
18413# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18414 if (end == 0) then
18415# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18416 value = trim(adjustl(line(start:))) ! Last value in the line
18417# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18418 else
18419# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18420 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
18421# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18422 start = start + end ! Move to next value
18423# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18424 end if
18425# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18426 if (l == 0) then
18427# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18428 read (value, *) y_th_arr(q) ! Convert string to numeric value
18429# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18430 else if (l == 1) then
18431# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18432 read (value, *) z_th_arr(q)
18433# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18434 else
18435# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18436 read (value, *) r_th_arr(q)
18437# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18438 end if
18439# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18440 end do
18441# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18442 end do
18443# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18444 close (10)
18445# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18446
18447# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18448 do q = 0, p
18449# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18450 do l = 0, n
18451# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18452 rcut = 0._wp
18453# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18454 do s = 0, njet - 1
18455# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18456 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
18457# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18458 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
18459# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18460 end do
18461# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18462 rcut_arr(l, q) = rcut
18463# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18464 end do
18465# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18466 end do
18467# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18468 else
18469# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18470 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
18471# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18472 end if
18473# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18474 end if
18475# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18476
18477# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18478 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
18479# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18480#ifdef MFC_DEBUG
18481# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18482 block
18483# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18484 use iso_fortran_env, only: output_unit
18485# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18486
18487# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18488 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
18489# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18490
18491# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18492 call flush (output_unit)
18493# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18494 end block
18495# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18496#endif
18497# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18498 allocate (ih(0:n_glb, 0:p_glb))
18499# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18500
18501# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18502
18503# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18504#if defined(MFC_OpenACC)
18505# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18506!$acc enter data create(ih)
18507# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18508#elif defined(MFC_OpenMP)
18509# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18510!$omp target enter data map(always,alloc:ih)
18511# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18512#endif
18513# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18514
18515# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18516 if (interface_file == '.') then
18517# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18518 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
18519# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18520 else
18521# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18522 inquire (file=trim(interface_file), exist=file_exist)
18523# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18524 if (file_exist) then
18525# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18526 open (unit=10, file=trim(interface_file), status="old", action="read")
18527# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18528 do i = 0, n_glb
18529# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18530 read (10, '(A)') line ! Read a full line as a string
18531# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18532 start = 1
18533# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18534
18535# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18536 do j = 0, p_glb
18537# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18538 end = index(line(start:), ',') ! Find the next comma
18539# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18540 if (end == 0) then
18541# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18542 value = trim(adjustl(line(start:))) ! Last value in the line
18543# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18544 else
18545# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18546 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
18547# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18548 start = start + end ! Move to next value
18549# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18550 end if
18551# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18552 read (value, *) ih(i, j) ! Convert string to numeric value
18553# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18554 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
18555# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18556 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
18557# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18558 end do
18559# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18560 end do
18561# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18562 close (10)
18563# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18564 else
18565# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18566 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
18567# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18568 end if
18569# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18570 end if
18571# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18572 end if
18573# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18574
18575# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18576 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
18577# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18578#ifdef MFC_DEBUG
18579# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18580 block
18581# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18582 use iso_fortran_env, only: output_unit
18583# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18584
18585# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18586 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
18587# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18588
18589# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18590 call flush (output_unit)
18591# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18592 end block
18593# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18594#endif
18595# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18596 allocate (ih(0:n_glb, 0:0))
18597# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18598
18599# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18600
18601# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18602#if defined(MFC_OpenACC)
18603# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18604!$acc enter data create(ih)
18605# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18606#elif defined(MFC_OpenMP)
18607# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18608!$omp target enter data map(always,alloc:ih)
18609# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18610#endif
18611# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18612 if (interface_file == '.') then
18613# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18614 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
18615# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18616 else
18617# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18618 inquire (file=trim(interface_file), exist=file_exist)
18619# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18620 if (file_exist) then
18621# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18622 open (unit=10, file=trim(interface_file), status="old", action="read")
18623# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18624 do i = 0, n_glb
18625# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18626 read (10, '(A)') line ! Read a full line as a string
18627# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18628 value = trim(line)
18629# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18630 read (value, *) ih(i, 0) ! Convert string to numeric value
18631# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18632 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
18633# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18634 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
18635# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18636 end do
18637# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18638 close (10)
18639# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18640 else
18641# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18642 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
18643# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18644 end if
18645# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18646 end if
18647# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18648 end if
18649
18650 ! Transferring the centroid information of the line to be swept
18651 x_centroid = patch_icpp(patch_id)%x_centroid
18652 y_centroid = patch_icpp(patch_id)%y_centroid
18653 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
18654 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
18655
18656 ! Obtaining coefficients of the equation describing the sweep line
18657 a = patch_icpp(patch_id)%normal(1)
18658 b = patch_icpp(patch_id)%normal(2)
18659 c = -a*x_centroid - b*y_centroid
18660
18661 ! Initialize eta=1; modified if smoothing is enabled
18662 eta = 1._wp
18663
18664 ! Assign patch vars if cell is covered and patch has write permission
18665 do j = 0, n
18666 do i = 0, m
18667 if (patch_icpp(patch_id)%smoothen) then
18668 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx_min, dy_min)*(a*x_cc(i) + b*y_cc(j) + c)/sqrt(a**2 + b**2))
18669 end if
18670
18671 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
18672 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
18673 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
18674
18675
18676 if (patch_icpp(patch_id)%hcid /= dflt_int) then
18677 select case (patch_icpp(patch_id)%hcid)
18678# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18679 case (300) ! Rayleigh-Taylor instability
18680# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18681 rhoh = 3._wp
18682# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18683 rhol = 1._wp
18684# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18685 pref = 1.e5_wp
18686# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18687 pint = pref
18688# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18689 h = 0.7_wp
18690# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18691 lam = 0.2_wp
18692# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18693 wl = 2._wp*pi/lam
18694# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18695 amp = 0.025_wp/wl
18696# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18697
18698# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18699 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
18700# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18701
18702# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18703 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
18704# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18705
18706# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18707 if (alph < eps) alph = eps
18708# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18709 if (alph > 1._wp - eps) alph = 1._wp - eps
18710# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18711
18712# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18713 if (y_cc(j) > inth) then
18714# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18715 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
18716# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18717 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
18718# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18719 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
18720# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18721 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
18722# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18723 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
18724# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18725 else
18726# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18727 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
18728# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18729 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
18730# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18731 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
18732# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18733 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
18734# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18735 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
18736# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18737 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
18738# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18739 end if
18740# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18741 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
18742# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18743 h = 0.0_wp
18744# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18745 lam = 1.0_wp
18746# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18747 amp = patch_icpp(patch_id)%a(2)
18748# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18749 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
18750# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18751 if (x_cc(i) > inth) then
18752# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18753 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
18754# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18755 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
18756# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18757 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
18758# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18759 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
18760# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18761 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
18762# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18763 end if
18764# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18765 case (302) ! 3D Jet with IGR
18766# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18767 ux_th = 10*sqrt(1.4*0.4)
18768# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18769 ux_am = 0.0*sqrt(1.4)
18770# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18771 p_th = 2.0_wp
18772# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18773 p_am = 1.0_wp
18774# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18775 rho_th = 1._wp
18776# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18777 rho_am = 1._wp
18778# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18779 y_th = 0.0_wp
18780# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18781 z_th = 0.0_wp
18782# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18783 r_th = 1._wp
18784# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18785 eps_smooth = 1._wp
18786# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18787 eps = 1e-6
18788# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18789
18790# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18791 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
18792# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18793 rcut = f_cut_on(r - r_th, eps_smooth)
18794# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18795 xcut = f_cut_on(x_cc(i), eps_smooth)
18796# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18797
18798# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18799 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
18800# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18801 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
18802# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18803 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
18804# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18805
18806# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18807 if (num_fluids == 1) then
18808# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18809 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
18810# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18811 else
18812# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18813 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
18814# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18815 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
18816# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18817 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))
18818# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18819 end if
18820# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18821
18822# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18823 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
18824# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18825 case (303) ! 3D Multijet
18826# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18827 eps_smooth = 3.0_wp
18828# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18829 ux_th = 10*sqrt(1.4*0.4)
18830# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18831 ux_am = 2.5*sqrt(1.4*0.4)
18832# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18833 p_th = 0.8_wp
18834# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18835 p_am = 0.4_wp
18836# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18837 rho_th = 1._wp
18838# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18839 rho_am = 1._wp
18840# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18841 eps = 1e-6
18842# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18843
18844# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18845 rcut = rcut_arr(j, k)
18846# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18847 xcut = f_cut_on(x_cc(i), eps_smooth)
18848# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18849
18850# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18851 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
18852# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18853 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
18854# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18855 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
18856# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18857
18858# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18859 if (num_fluids == 1) then
18860# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18861 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
18862# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18863 else
18864# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18865 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
18866# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18867 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
18868# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18869 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))
18870# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18871 end if
18872# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18873
18874# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18875 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
18876# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18877 case (304) ! 3D Interface from file cartesian
18878# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18879 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
18880# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18881
18882# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18883 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
18884# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18885 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
18886# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18887
18888# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18889 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
18890# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18891 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
18892# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18893
18894# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18895 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
18896# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18897 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
18898# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18899
18900# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18901 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
18902# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18903 case (305) ! 3D Interface from file axisymmetric
18904# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18905 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
18906# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18907
18908# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18909 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
18910# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18911 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
18912# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18913
18914# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18915 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
18916# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18917 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
18918# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18919
18920# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18921 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
18922# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18923 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
18924# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18925
18926# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18927 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
18928# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18929 case (370) ! 3D extrusion of 2D profile from external data
18930# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18931 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
18932# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18933 if (.not. files_loaded) then
18934# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18935 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
18936# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18937 do f = 1, max_files
18938# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18939 write (file_num_str, '(I0)') f
18940# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18941 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
18942# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18943 end do
18944# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18945
18946# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18947 ! Common file reading setup
18948# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18949 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
18950# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18951 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
18952# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18953
18954# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18955 select case (num_dims)
18956# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18957 case (1, 2) ! 1D and 2D cases are similar
18958# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18959 ! Count lines
18960# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18961 line_count = 0
18962# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18963 do
18964# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18965 read (unit2, *, iostat=ios2) dummy_x, dummy_y
18966# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18967 if (ios2 /= 0) exit
18968# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18969 line_count = line_count + 1
18970# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18971 end do
18972# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18973 close (unit2)
18974# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18975
18976# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18977 xrows = line_count
18978# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18979 yrows = 1
18980# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18981 index_x = 0
18982# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18983 if (num_dims == 2) index_x = i
18984# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18985#ifdef MFC_DEBUG
18986# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18987 block
18988# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18989 use iso_fortran_env, only: output_unit
18990# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18991
18992# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18993 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
18994# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18995
18996# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18997 call flush (output_unit)
18998# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18999 end block
19000# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19001#endif
19002# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19003 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
19004# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19005
19006# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19007
19008# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19009
19010# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19011#if defined(MFC_OpenACC)
19012# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19013!$acc enter data create(x_coords, stored_values)
19014# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19015#elif defined(MFC_OpenMP)
19016# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19017!$omp target enter data map(always,alloc:x_coords, stored_values)
19018# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19019#endif
19020# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19021
19022# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19023 ! Read data from all files
19024# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19025 do f = 1, max_files
19026# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19027 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
19028# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19029 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
19030# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19031
19032# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19033 do iter = 1, xrows
19034# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19035 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
19036# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19037 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
19038# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19039 end do
19040# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19041 close (unit)
19042# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19043 end do
19044# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19045
19046# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19047 ! Calculate offsets
19048# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19049 domain_xstart = x_coords(1)
19050# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19051 x_step = x_cc(1) - x_cc(0)
19052# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19053 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
19054# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19055 global_offset_x = nint(abs(delta_x)/x_step)
19056# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19057 case (3) ! 3D case - determine grid structure
19058# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19059 ! Find yRows by counting rows with same x
19060# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19061 read (unit2, *, iostat=ios2) x0, y0, dummy_z
19062# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19063 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
19064# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19065
19066# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19067 yrows = 1
19068# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19069 do
19070# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19071 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
19072# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19073 if (ios2 /= 0) exit
19074# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19075 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
19076# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19077 yrows = yrows + 1
19078# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19079 else
19080# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19081 exit
19082# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19083 end if
19084# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19085 end do
19086# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19087 close (unit2)
19088# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19089
19090# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19091 ! Count total rows
19092# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19093 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
19094# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19095 nrows = 0
19096# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19097 do
19098# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19099 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
19100# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19101 if (ios2 /= 0) exit
19102# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19103 nrows = nrows + 1
19104# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19105 end do
19106# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19107 close (unit2)
19108# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19109
19110# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19111 xrows = nrows/yrows
19112# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19113#ifdef MFC_DEBUG
19114# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19115 block
19116# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19117 use iso_fortran_env, only: output_unit
19118# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19119
19120# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19121 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
19122# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19123
19124# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19125 call flush (output_unit)
19126# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19127 end block
19128# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19129#endif
19130# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19131 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
19132# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19133
19134# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19135
19136# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19137
19138# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19139
19140# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19141#if defined(MFC_OpenACC)
19142# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19143!$acc enter data create(x_coords, y_coords, stored_values)
19144# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19145#elif defined(MFC_OpenMP)
19146# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19147!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
19148# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19149#endif
19150# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19151 index_x = i
19152# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19153 index_y = j
19154# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19155
19156# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19157 ! Read all files
19158# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19159 do f = 1, max_files
19160# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19161 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
19162# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19163 if (ios /= 0) then
19164# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19165 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
19166# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19167 cycle
19168# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19169 end if
19170# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19171
19172# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19173 iter = 0
19174# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19175 do iix = 1, xrows
19176# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19177 do iiy = 1, yrows
19178# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19179 iter = iter + 1
19180# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19181 if (f == 1) then
19182# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19183 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
19184# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19185 else
19186# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19187 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
19188# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19189 end if
19190# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19191 if (ios /= 0) call s_mpi_abort("Error reading data")
19192# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19193 end do
19194# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19195 end do
19196# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19197 close (unit)
19198# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19199 end do
19200# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19201
19202# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19203 ! Calculate offsets
19204# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19205 x_step = x_cc(1) - x_cc(0)
19206# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19207 y_step = y_cc(1) - y_cc(0)
19208# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19209 delta_x = x_cc(index_x) - x_coords(1)
19210# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19211 delta_y = y_cc(index_y) - y_coords(1)
19212# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19213 global_offset_x = nint(abs(delta_x)/x_step)
19214# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19215 global_offset_y = nint(abs(delta_y)/y_step)
19216# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19217 end select
19218# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19219
19220# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19221 files_loaded = .true.
19222# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19223 end if
19224# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19225
19226# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19227 ! Data assignment
19228# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19229 select case (num_dims)
19230# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19231 case (1)
19232# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19233 idx = i + 1 + global_offset_x
19234# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19235 ! idx must land inside the file's row range: this rank's subdomain offset
19236# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19237 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
19238# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19239 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
19240# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19241 if (idx < 1 .or. idx > xrows) &
19242# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19243 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
19244# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19245 do f = 1, sys_size
19246# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19247 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
19248# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19249 end do
19250# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19251 case (2)
19252# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19253 idx = i + 1 + global_offset_x - index_x
19254# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19255 if (idx < 1 .or. idx > xrows) &
19256# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19257 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
19258# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19259 do f = 1, sys_size - 1
19260# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19261 jump = merge(1, 0, f >= eqn_idx%mom%end)
19262# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19263 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
19264# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19265 end do
19266# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19267 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19268# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19269 case (3)
19270# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19271 idx = i + 1 + global_offset_x - index_x
19272# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19273 idy = j + 1 + global_offset_y - index_y
19274# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19275 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
19276# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19277 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
19278# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19279 do f = 1, sys_size - 1
19280# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19281 jump = merge(1, 0, f >= eqn_idx%mom%end)
19282# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19283 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
19284# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19285 end do
19286# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19287 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
19288# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19289 end select
19290# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19291 case (380) ! Taylor-Green vortex
19292# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19293 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
19294# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19295 ! geometry 9
19296# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19297 mach = 0.1
19298# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19299 if (patch_id == 1) then
19300# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19301 q_prim_vf(eqn_idx%E)%sf(i, j, &
19302# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19303 & 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)
19304# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19305 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)
19306# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19307 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)
19308# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19309 end if
19310# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19311 case default
19312# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19313 call s_int_to_str(patch_id, istr)
19314# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19315 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
19316# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19317 end select
19318 end if
19319
19320 ! Updating the patch identities bookkeeping variable
19321 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
19322 end if
19323 end do
19324 end do
19325 if (allocated(stored_values)) then
19326# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19327#ifdef MFC_DEBUG
19328# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19329 block
19330# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19331 use iso_fortran_env, only: output_unit
19332# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19333
19334# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19335 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(stored_values)'
19336# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19337
19338# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19339 call flush (output_unit)
19340# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19341 end block
19342# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19343#endif
19344# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19345
19346# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19347#if defined(MFC_OpenACC)
19348# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19349!$acc exit data delete(stored_values)
19350# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19351#elif defined(MFC_OpenMP)
19352# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19353!$omp target exit data map(release:stored_values)
19354# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19355#endif
19356# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19357 deallocate (stored_values)
19358# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19359#ifdef MFC_DEBUG
19360# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19361 block
19362# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19363 use iso_fortran_env, only: output_unit
19364# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19365
19366# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19367 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(x_coords)'
19368# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19369
19370# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19371 call flush (output_unit)
19372# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19373 end block
19374# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19375#endif
19376# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19377
19378# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19379#if defined(MFC_OpenACC)
19380# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19381!$acc exit data delete(x_coords)
19382# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19383#elif defined(MFC_OpenMP)
19384# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19385!$omp target exit data map(release:x_coords)
19386# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19387#endif
19388# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19389 deallocate (x_coords)
19390# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19391 end if
19392# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19393
19394# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19395 if (allocated(y_coords)) then
19396# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19397#ifdef MFC_DEBUG
19398# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19399 block
19400# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19401 use iso_fortran_env, only: output_unit
19402# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19403
19404# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19405 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(y_coords)'
19406# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19407
19408# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19409 call flush (output_unit)
19410# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19411 end block
19412# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19413#endif
19414# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19415
19416# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19417#if defined(MFC_OpenACC)
19418# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19419!$acc exit data delete(y_coords)
19420# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19421#elif defined(MFC_OpenMP)
19422# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19423!$omp target exit data map(release:y_coords)
19424# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19425#endif
19426# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19427 deallocate (y_coords)
19428# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19429 end if
19430# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19431
19432# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19433 files_loaded = .false.
19434# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19435
19436# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19437 if (allocated(stored_values274)) then
19438# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19439#ifdef MFC_DEBUG
19440# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19441 block
19442# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19443 use iso_fortran_env, only: output_unit
19444# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19445
19446# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19447 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(stored_values274)'
19448# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19449
19450# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19451 call flush (output_unit)
19452# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19453 end block
19454# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19455#endif
19456# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19457
19458# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19459#if defined(MFC_OpenACC)
19460# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19461!$acc exit data delete(stored_values274)
19462# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19463#elif defined(MFC_OpenMP)
19464# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19465!$omp target exit data map(release:stored_values274)
19466# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19467#endif
19468# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19469 deallocate (stored_values274)
19470# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19471 end if
19472# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19473
19474# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19475 files_loaded274 = .false.
19476
19477 end subroutine s_icpp_sweep_line
19478
19479 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
19480 !! Geometry of the patch is well-defined when its centroid are provided.
19481 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
19482
19483 integer, intent(in) :: patch_id
19484
19485#ifdef MFC_MIXED_PRECISION
19486 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
19487#else
19488 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
19489#endif
19490 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
19491 integer :: i, j, k !< generic loop iterators
19492 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
19493
19494 integer :: xRows, yRows, nRows, iix, iiy, max_files
19495# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19496 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
19497# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19498 real(wp) :: x_step, y_step
19499# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19500 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
19501# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19502 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
19503# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19504 real(wp) :: delta_x, delta_y
19505# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19506 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
19507# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19508 real(wp), allocatable :: stored_values(:,:,:)
19509# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19510 real(wp), allocatable :: x_coords(:), y_coords(:)
19511# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19512 logical :: files_loaded = .false.
19513# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19514 real(wp) :: domain_xstart
19515# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19516 character(len=20) :: file_num_str !< For storing the file number as a string
19517# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19518 integer :: ios
19519# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19520 integer :: ios2
19521# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19522
19523# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19524 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
19525# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19526 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
19527# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19528 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
19529# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19530 ! y_coords/files_loaded above.
19531# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19532 real(wp), allocatable, dimension(:,:,:) :: stored_values274
19533# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19534 logical :: files_loaded274 = .false.
19535# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19536 integer :: f274, ix274, iy274, unit274, ios274
19537# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19538 integer :: local_ix_beg274, local_iy_beg274
19539# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19540 character(len=300) :: fname274
19541# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19542 character(len=20) :: file_num_str274
19543# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19544 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
19545# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19546 real(wp) :: file_dx274, file_dy274, r_align274
19547 ! Place any declaration of intermediate variables here
19548# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19549 real(wp) :: eps, eps_mhd, C_mhd
19550# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19551 real(wp) :: r, rmax, gam, umax, p0
19552# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19553 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
19554# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19555 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
19556# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19557 real(wp) :: r0, alpha, r2
19558# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19559 real(wp) :: sinA, cosA
19560# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19561 real(wp) :: r_sq
19562# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19563
19564# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19565 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
19566# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19567 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
19568# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19569 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
19570# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19571 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
19572# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19573 integer :: igq, jgq
19574# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19575
19576# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19577 ! # 291 - Shear/Thermal Layer Case
19578# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19579 real(wp) :: delta_shear, u_max, u_mean
19580# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19581 real(wp) :: T_wall, T_inf, P_atm, T_loc
19582# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19583 real(wp) :: delta_th, R_mix
19584# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19585 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
19586# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19587 real(wp) :: bottom_blend_u, bottom_blend_T
19588# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19589
19590# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19591 ! # 207
19592# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19593 real(wp) :: sigma, gauss1, gauss2
19594# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19595
19596# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19597 ! # 208
19598# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19599 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
19600# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19601 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
19602# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19603 integer :: v, idx_lo, idx_hi, idx_mid
19604# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19605 real(wp), parameter :: Ly_param = 0.00775735_wp
19606# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19607 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
19608# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19609 integer, parameter :: Nwaves = 6
19610# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19611 real(wp), parameter :: y0_ref = 0.0_wp
19612# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19613
19614# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19615 eps = 1.e-9_wp
19616
19617 ! Transferring the patch's centroid and length information
19618 x_centroid = patch_icpp(patch_id)%x_centroid
19619 y_centroid = patch_icpp(patch_id)%y_centroid
19620 length_x = patch_icpp(patch_id)%length_x
19621 length_y = patch_icpp(patch_id)%length_y
19622
19623 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
19624 x_boundary%beg = x_centroid - 0.5_wp*length_x
19625 x_boundary%end = x_centroid + 0.5_wp*length_x
19626 y_boundary%beg = y_centroid - 0.5_wp*length_y
19627 y_boundary%end = y_centroid + 0.5_wp*length_y
19628
19629 ! Set eta=1 (no smoothing for this patch type)
19630 eta = 1._wp
19631 ! U0 is the characteristic velocity of the vortex
19632 u0 = patch_icpp(patch_id)%vel(1)
19633 ! L0 is the characteristic length of the vortex
19634 l0 = patch_icpp(patch_id)%vel(2)
19635 ! Assign patch vars if cell is covered and patch has write permission
19636 do j = 0, n
19637 do i = 0, m
19638 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, &
19639 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
19640 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
19641
19642
19643 if (patch_icpp(patch_id)%hcid /= dflt_int) then
19644 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
19645# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19646 case (200) ! Two-fluid cubic interface
19647# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19648 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
19649# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19650 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
19651# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19652 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
19653# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19654 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
19655# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19656 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
19657# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19658 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
19659# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19660 end if
19661# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19662 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
19663# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19664 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
19665# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19666 rmax = 0.2_wp
19667# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19668
19669# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19670 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
19671# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19672 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
19673# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19674 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
19675# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19676
19677# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19678 if (r < rmax) then
19679# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19680 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
19681# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19682 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
19683# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19684 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
19685# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19686 else if (r < 2*rmax) then
19687# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19688 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
19689# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19690 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
19691# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19692 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)))
19693# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19694 else
19695# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19696 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
19697# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19698 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
19699# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19700 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
19701# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19702 end if
19703# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19704 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
19705# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19706 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
19707# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19708 rmax = 0.2_wp
19709# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19710
19711# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19712 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
19713# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19714 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
19715# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19716 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
19717# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19718
19719# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19720 if (r < rmax) then
19721# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19722 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
19723# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19724 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
19725# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19726 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
19727# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19728 else if (r < 2*rmax) then
19729# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19730 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
19731# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19732 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
19733# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19734 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)))
19735# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19736 else
19737# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19738 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
19739# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19740 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
19741# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19742 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
19743# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19744 end if
19745# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19746
19747# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19748 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
19749# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19750 case (204) ! Rayleigh-Taylor instability
19751# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19752 rhoh = 3._wp
19753# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19754 rhol = 1._wp
19755# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19756 pref = 1.e5_wp
19757# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19758 pint = pref
19759# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19760 h = 0.7_wp
19761# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19762 lam = 0.2_wp
19763# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19764 wl = 2._wp*pi/lam
19765# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19766 amp = 0.05_wp/wl
19767# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19768
19769# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19770 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
19771# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19772
19773# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19774 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
19775# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19776
19777# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19778 if (alph < eps) alph = eps
19779# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19780 if (alph > 1._wp - eps) alph = 1._wp - eps
19781# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19782
19783# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19784 if (y_cc(j) > inth) then
19785# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19786 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
19787# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19788 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
19789# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19790 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
19791# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19792 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
19793# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19794 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
19795# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19796 else
19797# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19798 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
19799# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19800 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
19801# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19802 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
19803# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19804 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
19805# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19806 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
19807# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19808 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
19809# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19810 end if
19811# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19812 case (205) ! 2D lung wave interaction problem
19813# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19814 h = 0.0_wp ! non dim origin y
19815# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19816 lam = 1.0_wp ! non dim lambda
19817# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19818 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
19819# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19820
19821# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19822 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
19823# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19824
19825# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19826 if (y_cc(j) > inth) then
19827# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19828 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
19829# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19830 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
19831# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19832 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
19833# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19834 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
19835# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19836 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
19837# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19838 end if
19839# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19840 case (206) ! 2D lung wave interaction problem - horizontal domain
19841# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19842 h = 0.0_wp ! non dim origin y
19843# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19844 lam = 1.0_wp ! non dim lambda
19845# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19846 amp = patch_icpp(patch_id)%a(2)
19847# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19848
19849# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19850 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
19851# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19852
19853# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19854 if (x_cc(i) > intl) then ! this is the liquid
19855# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19856 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
19857# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19858 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
19859# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19860 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
19861# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19862 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
19863# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19864 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
19865# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19866 end if
19867# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19868 case (207) ! Kelvin Helmholtz Instability
19869# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19870 sigma = 0.05_wp/sqrt(2.0_wp)
19871# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19872 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
19873# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19874 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
19875# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19876 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)
19877# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19878 case (208) ! Richtmeyer Meshkov Instability
19879# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19880 lam = 1.0_wp
19881# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19882 eps = 1.0e-6_wp
19883# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19884 ei = 5.0_wp
19885# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19886 ! Smoothening function to smooth out sharp discontinuity in the interface
19887# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19888 if (x_cc(i) <= 0.7_wp*lam) then
19889# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19890 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
19891# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19892 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
19893# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19894 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
19895# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19896 alpha_sf6 = 1.0_wp - alpha_air
19897# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19898 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
19899# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19900 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
19901# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19902 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
19903# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19904 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
19905# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19906 end if
19907# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19908 case (250) ! MHD Orszag-Tang vortex
19909# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19910 ! 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),
19911# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19912 ! sin(4*pi*x)/sqrt(4*pi), 0)
19913# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19914
19915# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19916 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
19917# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19918 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
19919# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19920
19921# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19922 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
19923# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19924 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
19925# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19926 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
19927# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19928 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
19929# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19930 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
19931# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19932 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
19933# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19934 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
19935# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19936 ! Linear interpolation between r=0.08 and r=1.0
19937# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19938 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
19939# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19940 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
19941# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19942 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
19943# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19944 else
19945# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19946 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
19947# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19948 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
19949# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19950 end if
19951# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19952
19953# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19954 ! case 252 is for the 2D MHD Rotor problem
19955# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19956 case (252) ! 2D MHD Rotor Problem
19957# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19958 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
19959# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19960 !
19961# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19962 ! 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
19963# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19964 ! velocity w=20, giving v_tan=2 at r=0.1
19965# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19966
19967# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19968 ! Calculate distance squared from the center
19969# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19970 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
19971# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19972
19973# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19974 ! inner radius of 0.1
19975# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19976 if (r_sq <= 0.1**2) then
19977# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19978 ! -- Inside the rotor -- Set density uniformly to 10
19979# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19980 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
19981# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19982
19983# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19984 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
19985# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19986 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
19987# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19988 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
19989# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19990
19991# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19992 ! taper width of 0.015
19993# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19994 else if (r_sq <= 0.115**2) then
19995# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19996 ! linearly smooth the function between r = 0.1 and 0.115
19997# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19998 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
19999# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20000
20001# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20002 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)
20003# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20004 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)
20005# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20006 end if
20007# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20008 case (253) ! MHD Smooth Magnetic Vortex
20009# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20010 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
20011# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20012 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
20013# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20014
20015# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20016 ! velocity
20017# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20018 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))
20019# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20020 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))
20021# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20022
20023# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20024 ! magnetic field
20025# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20026 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)
20027# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20028 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)
20029# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20030
20031# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20032 ! pressure
20033# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20034 q_prim_vf(eqn_idx%E)%sf(i, j, &
20035# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20036 & 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)
20037# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20038 case (260) ! Gaussian Divergence Pulse
20039# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20040 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
20041# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20042 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
20043# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20044 ! initialized to zero everywhere.
20045# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20046
20047# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20048 eps_mhd = patch_icpp(patch_id)%a(2)
20049# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20050 sigma = patch_icpp(patch_id)%a(3)
20051# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20052 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
20053# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20054
20055# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20056 ! B-field
20057# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20058 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
20059# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20060 case (261) ! Blob
20061# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20062 r0 = 1._wp/sqrt(8._wp)
20063# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20064 r2 = x_cc(i)**2 + y_cc(j)**2
20065# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20066 r = sqrt(r2)
20067# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20068 alpha = r/r0
20069# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20070 if (alpha < 1) then
20071# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20072 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)
20073# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20074 ! 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)
20075# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20076 ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
20077# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20078 ! 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
20079# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20080 end if
20081# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20082 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
20083# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20084 ! rotate by \alpha = atan(2)
20085# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20086 alpha = atan(2._wp)
20087# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20088 cosa = cos(alpha)
20089# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20090 sina = sin(alpha)
20091# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20092 ! projection along shock normal
20093# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20094 r = x_cc(i)*cosa + y_cc(j)*sina
20095# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20096
20097# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20098 if (r <= 0.5_wp) then
20099# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20100 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
20101# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20102 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
20103# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20104 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
20105# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20106 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
20107# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20108 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
20109# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20110 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
20111# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20112 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
20113# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20114 else
20115# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20116 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
20117# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20118 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
20119# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20120 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
20121# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20122 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
20123# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20124 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
20125# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20126 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
20127# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20128 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
20129# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20130 end if
20131# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20132 ! v^z and B^z remain zero by default
20133# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20134 case (270) ! 2D extrusion of 1D profile from external data
20135# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20136 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
20137# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20138 if (.not. files_loaded) then
20139# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20140 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
20141# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20142 do f = 1, max_files
20143# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20144 write (file_num_str, '(I0)') f
20145# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20146 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
20147# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20148 end do
20149# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20150
20151# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20152 ! Common file reading setup
20153# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20154 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20155# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20156 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
20157# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20158
20159# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20160 select case (num_dims)
20161# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20162 case (1, 2) ! 1D and 2D cases are similar
20163# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20164 ! Count lines
20165# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20166 line_count = 0
20167# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20168 do
20169# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20170 read (unit2, *, iostat=ios2) dummy_x, dummy_y
20171# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20172 if (ios2 /= 0) exit
20173# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20174 line_count = line_count + 1
20175# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20176 end do
20177# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20178 close (unit2)
20179# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20180
20181# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20182 xrows = line_count
20183# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20184 yrows = 1
20185# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20186 index_x = 0
20187# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20188 if (num_dims == 2) index_x = i
20189# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20190#ifdef MFC_DEBUG
20191# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20192 block
20193# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20194 use iso_fortran_env, only: output_unit
20195# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20196
20197# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20198 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
20199# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20200
20201# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20202 call flush (output_unit)
20203# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20204 end block
20205# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20206#endif
20207# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20208 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
20209# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20210
20211# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20212
20213# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20214
20215# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20216#if defined(MFC_OpenACC)
20217# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20218!$acc enter data create(x_coords, stored_values)
20219# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20220#elif defined(MFC_OpenMP)
20221# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20222!$omp target enter data map(always,alloc:x_coords, stored_values)
20223# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20224#endif
20225# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20226
20227# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20228 ! Read data from all files
20229# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20230 do f = 1, max_files
20231# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20232 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20233# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20234 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20235# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20236
20237# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20238 do iter = 1, xrows
20239# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20240 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
20241# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20242 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
20243# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20244 end do
20245# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20246 close (unit)
20247# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20248 end do
20249# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20250
20251# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20252 ! Calculate offsets
20253# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20254 domain_xstart = x_coords(1)
20255# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20256 x_step = x_cc(1) - x_cc(0)
20257# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20258 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
20259# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20260 global_offset_x = nint(abs(delta_x)/x_step)
20261# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20262 case (3) ! 3D case - determine grid structure
20263# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20264 ! Find yRows by counting rows with same x
20265# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20266 read (unit2, *, iostat=ios2) x0, y0, dummy_z
20267# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20268 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
20269# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20270
20271# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20272 yrows = 1
20273# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20274 do
20275# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20276 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20277# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20278 if (ios2 /= 0) exit
20279# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20280 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
20281# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20282 yrows = yrows + 1
20283# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20284 else
20285# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20286 exit
20287# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20288 end if
20289# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20290 end do
20291# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20292 close (unit2)
20293# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20294
20295# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20296 ! Count total rows
20297# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20298 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20299# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20300 nrows = 0
20301# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20302 do
20303# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20304 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20305# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20306 if (ios2 /= 0) exit
20307# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20308 nrows = nrows + 1
20309# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20310 end do
20311# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20312 close (unit2)
20313# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20314
20315# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20316 xrows = nrows/yrows
20317# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20318#ifdef MFC_DEBUG
20319# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20320 block
20321# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20322 use iso_fortran_env, only: output_unit
20323# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20324
20325# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20326 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
20327# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20328
20329# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20330 call flush (output_unit)
20331# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20332 end block
20333# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20334#endif
20335# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20336 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
20337# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20338
20339# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20340
20341# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20342
20343# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20344
20345# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20346#if defined(MFC_OpenACC)
20347# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20348!$acc enter data create(x_coords, y_coords, stored_values)
20349# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20350#elif defined(MFC_OpenMP)
20351# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20352!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
20353# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20354#endif
20355# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20356 index_x = i
20357# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20358 index_y = j
20359# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20360
20361# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20362 ! Read all files
20363# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20364 do f = 1, max_files
20365# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20366 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20367# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20368 if (ios /= 0) then
20369# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20370 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20371# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20372 cycle
20373# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20374 end if
20375# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20376
20377# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20378 iter = 0
20379# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20380 do iix = 1, xrows
20381# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20382 do iiy = 1, yrows
20383# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20384 iter = iter + 1
20385# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20386 if (f == 1) then
20387# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20388 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
20389# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20390 else
20391# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20392 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
20393# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20394 end if
20395# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20396 if (ios /= 0) call s_mpi_abort("Error reading data")
20397# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20398 end do
20399# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20400 end do
20401# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20402 close (unit)
20403# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20404 end do
20405# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20406
20407# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20408 ! Calculate offsets
20409# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20410 x_step = x_cc(1) - x_cc(0)
20411# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20412 y_step = y_cc(1) - y_cc(0)
20413# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20414 delta_x = x_cc(index_x) - x_coords(1)
20415# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20416 delta_y = y_cc(index_y) - y_coords(1)
20417# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20418 global_offset_x = nint(abs(delta_x)/x_step)
20419# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20420 global_offset_y = nint(abs(delta_y)/y_step)
20421# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20422 end select
20423# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20424
20425# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20426 files_loaded = .true.
20427# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20428 end if
20429# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20430
20431# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20432 ! Data assignment
20433# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20434 select case (num_dims)
20435# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20436 case (1)
20437# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20438 idx = i + 1 + global_offset_x
20439# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20440 ! idx must land inside the file's row range: this rank's subdomain offset
20441# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20442 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
20443# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20444 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
20445# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20446 if (idx < 1 .or. idx > xrows) &
20447# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20448 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20449# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20450 do f = 1, sys_size
20451# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20452 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
20453# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20454 end do
20455# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20456 case (2)
20457# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20458 idx = i + 1 + global_offset_x - index_x
20459# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20460 if (idx < 1 .or. idx > xrows) &
20461# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20462 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20463# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20464 do f = 1, sys_size - 1
20465# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20466 jump = merge(1, 0, f >= eqn_idx%mom%end)
20467# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20468 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
20469# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20470 end do
20471# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20472 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
20473# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20474 case (3)
20475# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20476 idx = i + 1 + global_offset_x - index_x
20477# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20478 idy = j + 1 + global_offset_y - index_y
20479# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20480 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
20481# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20482 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
20483# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20484 do f = 1, sys_size - 1
20485# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20486 jump = merge(1, 0, f >= eqn_idx%mom%end)
20487# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20488 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
20489# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20490 end do
20491# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20492 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
20493# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20494 end select
20495# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20496 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
20497# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20498 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
20499# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20500 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
20501# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20502 ! cross-stream-position profile (real cross-stream velocity is legitimately
20503# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20504 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
20505# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20506 ! zero out mom%beg's true physical value.
20507# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20508 if (.not. files_loaded) then
20509# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20510 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
20511# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20512 do f = 1, max_files
20513# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20514 write (file_num_str, '(I0)') f
20515# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20516 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
20517# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20518 end do
20519# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20520
20521# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20522 ! Common file reading setup
20523# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20524 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20525# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20526 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
20527# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20528
20529# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20530 select case (num_dims)
20531# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20532 case (1, 2) ! 1D and 2D cases are similar
20533# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20534 ! Count lines
20535# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20536 line_count = 0
20537# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20538 do
20539# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20540 read (unit2, *, iostat=ios2) dummy_x, dummy_y
20541# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20542 if (ios2 /= 0) exit
20543# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20544 line_count = line_count + 1
20545# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20546 end do
20547# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20548 close (unit2)
20549# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20550
20551# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20552 xrows = line_count
20553# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20554 yrows = 1
20555# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20556 index_x = 0
20557# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20558 if (num_dims == 2) index_x = i
20559# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20560#ifdef MFC_DEBUG
20561# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20562 block
20563# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20564 use iso_fortran_env, only: output_unit
20565# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20566
20567# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20568 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
20569# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20570
20571# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20572 call flush (output_unit)
20573# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20574 end block
20575# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20576#endif
20577# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20578 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
20579# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20580
20581# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20582
20583# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20584
20585# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20586#if defined(MFC_OpenACC)
20587# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20588!$acc enter data create(x_coords, stored_values)
20589# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20590#elif defined(MFC_OpenMP)
20591# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20592!$omp target enter data map(always,alloc:x_coords, stored_values)
20593# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20594#endif
20595# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20596
20597# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20598 ! Read data from all files
20599# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20600 do f = 1, max_files
20601# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20602 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20603# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20604 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20605# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20606
20607# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20608 do iter = 1, xrows
20609# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20610 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
20611# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20612 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
20613# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20614 end do
20615# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20616 close (unit)
20617# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20618 end do
20619# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20620
20621# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20622 ! Calculate offsets
20623# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20624 domain_xstart = x_coords(1)
20625# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20626 x_step = x_cc(1) - x_cc(0)
20627# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20628 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
20629# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20630 global_offset_x = nint(abs(delta_x)/x_step)
20631# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20632 case (3) ! 3D case - determine grid structure
20633# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20634 ! Find yRows by counting rows with same x
20635# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20636 read (unit2, *, iostat=ios2) x0, y0, dummy_z
20637# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20638 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
20639# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20640
20641# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20642 yrows = 1
20643# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20644 do
20645# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20646 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20647# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20648 if (ios2 /= 0) exit
20649# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20650 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
20651# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20652 yrows = yrows + 1
20653# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20654 else
20655# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20656 exit
20657# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20658 end if
20659# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20660 end do
20661# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20662 close (unit2)
20663# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20664
20665# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20666 ! Count total rows
20667# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20668 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20669# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20670 nrows = 0
20671# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20672 do
20673# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20674 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20675# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20676 if (ios2 /= 0) exit
20677# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20678 nrows = nrows + 1
20679# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20680 end do
20681# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20682 close (unit2)
20683# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20684
20685# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20686 xrows = nrows/yrows
20687# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20688#ifdef MFC_DEBUG
20689# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20690 block
20691# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20692 use iso_fortran_env, only: output_unit
20693# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20694
20695# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20696 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
20697# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20698
20699# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20700 call flush (output_unit)
20701# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20702 end block
20703# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20704#endif
20705# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20706 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
20707# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20708
20709# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20710
20711# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20712
20713# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20714
20715# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20716#if defined(MFC_OpenACC)
20717# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20718!$acc enter data create(x_coords, y_coords, stored_values)
20719# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20720#elif defined(MFC_OpenMP)
20721# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20722!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
20723# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20724#endif
20725# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20726 index_x = i
20727# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20728 index_y = j
20729# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20730
20731# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20732 ! Read all files
20733# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20734 do f = 1, max_files
20735# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20736 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20737# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20738 if (ios /= 0) then
20739# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20740 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20741# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20742 cycle
20743# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20744 end if
20745# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20746
20747# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20748 iter = 0
20749# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20750 do iix = 1, xrows
20751# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20752 do iiy = 1, yrows
20753# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20754 iter = iter + 1
20755# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20756 if (f == 1) then
20757# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20758 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
20759# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20760 else
20761# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20762 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
20763# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20764 end if
20765# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20766 if (ios /= 0) call s_mpi_abort("Error reading data")
20767# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20768 end do
20769# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20770 end do
20771# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20772 close (unit)
20773# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20774 end do
20775# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20776
20777# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20778 ! Calculate offsets
20779# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20780 x_step = x_cc(1) - x_cc(0)
20781# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20782 y_step = y_cc(1) - y_cc(0)
20783# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20784 delta_x = x_cc(index_x) - x_coords(1)
20785# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20786 delta_y = y_cc(index_y) - y_coords(1)
20787# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20788 global_offset_x = nint(abs(delta_x)/x_step)
20789# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20790 global_offset_y = nint(abs(delta_y)/y_step)
20791# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20792 end select
20793# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20794
20795# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20796 files_loaded = .true.
20797# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20798 end if
20799# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20800
20801# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20802 ! Data assignment
20803# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20804 select case (num_dims)
20805# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20806 case (1)
20807# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20808 idx = i + 1 + global_offset_x
20809# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20810 ! idx must land inside the file's row range: this rank's subdomain offset
20811# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20812 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
20813# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20814 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
20815# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20816 if (idx < 1 .or. idx > xrows) &
20817# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20818 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20819# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20820 do f = 1, sys_size
20821# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20822 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
20823# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20824 end do
20825# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20826 case (2)
20827# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20828 idx = i + 1 + global_offset_x - index_x
20829# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20830 if (idx < 1 .or. idx > xrows) &
20831# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20832 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20833# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20834 do f = 1, sys_size - 1
20835# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20836 jump = merge(1, 0, f >= eqn_idx%mom%end)
20837# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20838 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
20839# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20840 end do
20841# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20842 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
20843# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20844 case (3)
20845# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20846 idx = i + 1 + global_offset_x - index_x
20847# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20848 idy = j + 1 + global_offset_y - index_y
20849# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20850 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
20851# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20852 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
20853# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20854 do f = 1, sys_size - 1
20855# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20856 jump = merge(1, 0, f >= eqn_idx%mom%end)
20857# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20858 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
20859# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20860 end do
20861# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20862 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
20863# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20864 end select
20865# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20866 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
20867# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20868 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
20869# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20870 case (274) ! Full 2D field from external data (no extrusion)
20871# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20872 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
20873# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20874 ! extrusion direction and no zeroed component -- all sys_size variables are read and
20875# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20876 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
20877# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20878 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
20879# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20880 ! global grid exactly -- by construction, since the IC generator derives both the
20881# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20882 ! grid and the file contents from the same computation.
20883# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20884 !
20885# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20886 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
20887# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20888 ! file's own first coordinate and this rank's uniform grid spacing -- following the
20889# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20890 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
20891# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20892 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
20893# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20894 ! returns before allocating it otherwise), so a serial-IO run (the default for
20895# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20896 ! golden-file tests) would index into an unallocated array.
20897# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20898 !
20899# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20900 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
20901# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20902 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
20903# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20904 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
20905# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20906 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
20907# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20908 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
20909# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20910 ! global cell offset) are pinned from f274==1's very first record, before any other
20911# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20912 ! record is read, so every subsequent record -- across all variables -- can be tested
20913# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20914 ! against this rank's range and dropped if it falls outside it.
20915# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20916 x_step274 = x_cc(1) - x_cc(0)
20917# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20918 y_step274 = y_cc(1) - y_cc(0)
20919# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20920
20921# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20922 if (.not. files_loaded274) then
20923# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20924#ifdef MFC_DEBUG
20925# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20926 block
20927# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20928 use iso_fortran_env, only: output_unit
20929# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20930
20931# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20932 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
20933# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20934
20935# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20936 call flush (output_unit)
20937# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20938 end block
20939# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20940#endif
20941# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20942 allocate (stored_values274(0:m, 0:n, sys_size))
20943# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20944
20945# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20946
20947# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20948#if defined(MFC_OpenACC)
20949# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20950!$acc enter data create(stored_values274)
20951# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20952#elif defined(MFC_OpenMP)
20953# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20954!$omp target enter data map(always,alloc:stored_values274)
20955# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20956#endif
20957# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20958 do f274 = 1, sys_size
20959# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20960 write (file_num_str274, '(I0)') f274
20961# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20962 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
20963# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20964 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
20965# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20966 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
20967# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20968 do ix274 = 0, m_glb
20969# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20970 do iy274 = 0, n_glb
20971# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20972 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
20973# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20974 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
20975# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20976 ! Capture the file's own origin and spacing from its first records so we can
20977# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20978 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
20979# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20980 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
20981# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20982 if (f274 == 1) then
20983# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20984 if (ix274 == 0 .and. iy274 == 0) then
20985# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20986 x0_274 = dummy_x274
20987# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20988 y0_274 = dummy_y274
20989# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20990 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
20991# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20992 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
20993# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20994 end if
20995# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20996 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
20997# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20998 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
20999# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21000 end if
21001# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21002 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
21003# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21004 & .and. iy274 - local_iy_beg274 <= n) then
21005# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21006 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
21007# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21008 end if
21009# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21010 end do
21011# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21012 end do
21013# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21014 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
21015# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21016 ! read means it was generated for a larger grid and would be silently misread.
21017# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21018 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
21019# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21020 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
21021# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21022 close (unit274)
21023# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21024 end do
21025# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21026
21027# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21028 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
21029# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21030 ! Check alignment via the integer cell offset of this rank's first cell from the file
21031# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21032 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
21033# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21034 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
21035# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21036 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
21037# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21038 ! the global origin.) The spacing checks below must also hold.
21039# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21040 r_align274 = (x_cc(0) - x0_274)/x_step274
21041# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21042 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
21043# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21044 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
21045# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21046 if (m_glb >= 1) then
21047# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21048 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
21049# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21050 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
21051# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21052 end if
21053# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21054 if (n_glb >= 1) then
21055# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21056 r_align274 = (y_cc(0) - y0_274)/y_step274
21057# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21058 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
21059# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21060 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
21061# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21062 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
21063# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21064 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
21065# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21066 end if
21067# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21068
21069# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21070 files_loaded274 = .true.
21071# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21072 end if
21073# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21074 ! Alignment is verified above (or this rank would already have aborted), so the local
21075# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21076 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
21077# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21078 do f274 = 1, sys_size
21079# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21080 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
21081# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21082 end do
21083# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21084 case (271) ! Premixed Flame Vortices Interaction
21085# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21086 if (.not. files_loaded) then
21087# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21088 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
21089# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21090 do f = 1, max_files
21091# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21092 write (file_num_str, '(I0)') f
21093# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21094 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
21095# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21096 end do
21097# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21098
21099# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21100 ! Common file reading setup
21101# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21102 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21103# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21104 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
21105# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21106
21107# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21108 select case (num_dims)
21109# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21110 case (1, 2) ! 1D and 2D cases are similar
21111# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21112 ! Count lines
21113# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21114 line_count = 0
21115# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21116 do
21117# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21118 read (unit2, *, iostat=ios2) dummy_x, dummy_y
21119# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21120 if (ios2 /= 0) exit
21121# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21122 line_count = line_count + 1
21123# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21124 end do
21125# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21126 close (unit2)
21127# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21128
21129# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21130 xrows = line_count
21131# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21132 yrows = 1
21133# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21134 index_x = 0
21135# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21136 if (num_dims == 2) index_x = i
21137# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21138#ifdef MFC_DEBUG
21139# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21140 block
21141# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21142 use iso_fortran_env, only: output_unit
21143# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21144
21145# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21146 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
21147# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21148
21149# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21150 call flush (output_unit)
21151# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21152 end block
21153# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21154#endif
21155# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21156 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
21157# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21158
21159# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21160
21161# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21162
21163# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21164#if defined(MFC_OpenACC)
21165# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21166!$acc enter data create(x_coords, stored_values)
21167# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21168#elif defined(MFC_OpenMP)
21169# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21170!$omp target enter data map(always,alloc:x_coords, stored_values)
21171# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21172#endif
21173# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21174
21175# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21176 ! Read data from all files
21177# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21178 do f = 1, max_files
21179# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21180 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21181# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21182 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21183# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21184
21185# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21186 do iter = 1, xrows
21187# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21188 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
21189# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21190 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
21191# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21192 end do
21193# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21194 close (unit)
21195# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21196 end do
21197# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21198
21199# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21200 ! Calculate offsets
21201# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21202 domain_xstart = x_coords(1)
21203# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21204 x_step = x_cc(1) - x_cc(0)
21205# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21206 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
21207# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21208 global_offset_x = nint(abs(delta_x)/x_step)
21209# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21210 case (3) ! 3D case - determine grid structure
21211# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21212 ! Find yRows by counting rows with same x
21213# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21214 read (unit2, *, iostat=ios2) x0, y0, dummy_z
21215# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21216 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
21217# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21218
21219# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21220 yrows = 1
21221# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21222 do
21223# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21224 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21225# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21226 if (ios2 /= 0) exit
21227# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21228 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
21229# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21230 yrows = yrows + 1
21231# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21232 else
21233# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21234 exit
21235# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21236 end if
21237# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21238 end do
21239# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21240 close (unit2)
21241# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21242
21243# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21244 ! Count total rows
21245# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21246 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21247# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21248 nrows = 0
21249# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21250 do
21251# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21252 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21253# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21254 if (ios2 /= 0) exit
21255# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21256 nrows = nrows + 1
21257# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21258 end do
21259# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21260 close (unit2)
21261# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21262
21263# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21264 xrows = nrows/yrows
21265# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21266#ifdef MFC_DEBUG
21267# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21268 block
21269# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21270 use iso_fortran_env, only: output_unit
21271# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21272
21273# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21274 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
21275# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21276
21277# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21278 call flush (output_unit)
21279# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21280 end block
21281# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21282#endif
21283# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21284 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
21285# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21286
21287# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21288
21289# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21290
21291# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21292
21293# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21294#if defined(MFC_OpenACC)
21295# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21296!$acc enter data create(x_coords, y_coords, stored_values)
21297# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21298#elif defined(MFC_OpenMP)
21299# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21300!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
21301# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21302#endif
21303# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21304 index_x = i
21305# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21306 index_y = j
21307# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21308
21309# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21310 ! Read all files
21311# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21312 do f = 1, max_files
21313# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21314 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21315# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21316 if (ios /= 0) then
21317# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21318 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21319# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21320 cycle
21321# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21322 end if
21323# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21324
21325# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21326 iter = 0
21327# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21328 do iix = 1, xrows
21329# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21330 do iiy = 1, yrows
21331# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21332 iter = iter + 1
21333# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21334 if (f == 1) then
21335# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21336 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
21337# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21338 else
21339# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21340 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
21341# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21342 end if
21343# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21344 if (ios /= 0) call s_mpi_abort("Error reading data")
21345# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21346 end do
21347# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21348 end do
21349# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21350 close (unit)
21351# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21352 end do
21353# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21354
21355# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21356 ! Calculate offsets
21357# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21358 x_step = x_cc(1) - x_cc(0)
21359# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21360 y_step = y_cc(1) - y_cc(0)
21361# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21362 delta_x = x_cc(index_x) - x_coords(1)
21363# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21364 delta_y = y_cc(index_y) - y_coords(1)
21365# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21366 global_offset_x = nint(abs(delta_x)/x_step)
21367# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21368 global_offset_y = nint(abs(delta_y)/y_step)
21369# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21370 end select
21371# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21372
21373# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21374 files_loaded = .true.
21375# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21376 end if
21377# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21378
21379# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21380 ! Data assignment
21381# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21382 select case (num_dims)
21383# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21384 case (1)
21385# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21386 idx = i + 1 + global_offset_x
21387# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21388 ! idx must land inside the file's row range: this rank's subdomain offset
21389# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21390 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
21391# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21392 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
21393# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21394 if (idx < 1 .or. idx > xrows) &
21395# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21396 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21397# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21398 do f = 1, sys_size
21399# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21400 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
21401# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21402 end do
21403# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21404 case (2)
21405# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21406 idx = i + 1 + global_offset_x - index_x
21407# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21408 if (idx < 1 .or. idx > xrows) &
21409# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21410 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21411# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21412 do f = 1, sys_size - 1
21413# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21414 jump = merge(1, 0, f >= eqn_idx%mom%end)
21415# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21416 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
21417# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21418 end do
21419# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21420 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21421# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21422 case (3)
21423# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21424 idx = i + 1 + global_offset_x - index_x
21425# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21426 idy = j + 1 + global_offset_y - index_y
21427# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21428 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
21429# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21430 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
21431# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21432 do f = 1, sys_size - 1
21433# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21434 jump = merge(1, 0, f >= eqn_idx%mom%end)
21435# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21436 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
21437# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21438 end do
21439# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21440 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
21441# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21442 end select
21443# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21444 x1c = 0.0027_wp
21445# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21446 y1c = 0.005_wp
21447# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21448 x2c = 0.0027_wp
21449# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21450 y2c = 0.003_wp
21451# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21452 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
21453# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21454 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
21455# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21456 rvortex = 0.0005_wp
21457# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21458 cvortex = 6000.0_wp
21459# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21460
21461# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21462 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
21463# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21464 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
21465# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21466
21467# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21468 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
21469# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21470 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
21471# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21472 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
21473# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21474 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
21475# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21476 case (272) ! Premixed Flame Instability
21477# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21478 if (.not. files_loaded) then
21479# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21480 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
21481# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21482 do f = 1, max_files
21483# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21484 write (file_num_str, '(I0)') f
21485# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21486 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
21487# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21488 end do
21489# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21490
21491# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21492 ! Common file reading setup
21493# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21494 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21495# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21496 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
21497# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21498
21499# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21500 select case (num_dims)
21501# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21502 case (1, 2) ! 1D and 2D cases are similar
21503# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21504 ! Count lines
21505# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21506 line_count = 0
21507# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21508 do
21509# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21510 read (unit2, *, iostat=ios2) dummy_x, dummy_y
21511# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21512 if (ios2 /= 0) exit
21513# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21514 line_count = line_count + 1
21515# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21516 end do
21517# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21518 close (unit2)
21519# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21520
21521# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21522 xrows = line_count
21523# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21524 yrows = 1
21525# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21526 index_x = 0
21527# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21528 if (num_dims == 2) index_x = i
21529# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21530#ifdef MFC_DEBUG
21531# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21532 block
21533# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21534 use iso_fortran_env, only: output_unit
21535# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21536
21537# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21538 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
21539# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21540
21541# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21542 call flush (output_unit)
21543# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21544 end block
21545# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21546#endif
21547# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21548 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
21549# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21550
21551# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21552
21553# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21554
21555# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21556#if defined(MFC_OpenACC)
21557# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21558!$acc enter data create(x_coords, stored_values)
21559# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21560#elif defined(MFC_OpenMP)
21561# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21562!$omp target enter data map(always,alloc:x_coords, stored_values)
21563# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21564#endif
21565# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21566
21567# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21568 ! Read data from all files
21569# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21570 do f = 1, max_files
21571# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21572 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21573# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21574 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21575# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21576
21577# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21578 do iter = 1, xrows
21579# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21580 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
21581# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21582 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
21583# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21584 end do
21585# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21586 close (unit)
21587# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21588 end do
21589# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21590
21591# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21592 ! Calculate offsets
21593# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21594 domain_xstart = x_coords(1)
21595# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21596 x_step = x_cc(1) - x_cc(0)
21597# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21598 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
21599# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21600 global_offset_x = nint(abs(delta_x)/x_step)
21601# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21602 case (3) ! 3D case - determine grid structure
21603# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21604 ! Find yRows by counting rows with same x
21605# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21606 read (unit2, *, iostat=ios2) x0, y0, dummy_z
21607# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21608 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
21609# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21610
21611# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21612 yrows = 1
21613# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21614 do
21615# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21616 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21617# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21618 if (ios2 /= 0) exit
21619# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21620 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
21621# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21622 yrows = yrows + 1
21623# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21624 else
21625# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21626 exit
21627# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21628 end if
21629# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21630 end do
21631# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21632 close (unit2)
21633# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21634
21635# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21636 ! Count total rows
21637# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21638 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21639# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21640 nrows = 0
21641# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21642 do
21643# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21644 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21645# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21646 if (ios2 /= 0) exit
21647# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21648 nrows = nrows + 1
21649# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21650 end do
21651# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21652 close (unit2)
21653# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21654
21655# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21656 xrows = nrows/yrows
21657# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21658#ifdef MFC_DEBUG
21659# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21660 block
21661# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21662 use iso_fortran_env, only: output_unit
21663# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21664
21665# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21666 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
21667# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21668
21669# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21670 call flush (output_unit)
21671# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21672 end block
21673# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21674#endif
21675# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21676 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
21677# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21678
21679# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21680
21681# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21682
21683# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21684
21685# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21686#if defined(MFC_OpenACC)
21687# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21688!$acc enter data create(x_coords, y_coords, stored_values)
21689# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21690#elif defined(MFC_OpenMP)
21691# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21692!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
21693# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21694#endif
21695# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21696 index_x = i
21697# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21698 index_y = j
21699# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21700
21701# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21702 ! Read all files
21703# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21704 do f = 1, max_files
21705# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21706 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21707# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21708 if (ios /= 0) then
21709# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21710 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21711# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21712 cycle
21713# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21714 end if
21715# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21716
21717# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21718 iter = 0
21719# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21720 do iix = 1, xrows
21721# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21722 do iiy = 1, yrows
21723# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21724 iter = iter + 1
21725# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21726 if (f == 1) then
21727# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21728 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
21729# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21730 else
21731# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21732 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
21733# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21734 end if
21735# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21736 if (ios /= 0) call s_mpi_abort("Error reading data")
21737# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21738 end do
21739# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21740 end do
21741# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21742 close (unit)
21743# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21744 end do
21745# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21746
21747# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21748 ! Calculate offsets
21749# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21750 x_step = x_cc(1) - x_cc(0)
21751# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21752 y_step = y_cc(1) - y_cc(0)
21753# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21754 delta_x = x_cc(index_x) - x_coords(1)
21755# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21756 delta_y = y_cc(index_y) - y_coords(1)
21757# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21758 global_offset_x = nint(abs(delta_x)/x_step)
21759# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21760 global_offset_y = nint(abs(delta_y)/y_step)
21761# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21762 end select
21763# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21764
21765# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21766 files_loaded = .true.
21767# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21768 end if
21769# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21770
21771# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21772 ! Data assignment
21773# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21774 select case (num_dims)
21775# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21776 case (1)
21777# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21778 idx = i + 1 + global_offset_x
21779# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21780 ! idx must land inside the file's row range: this rank's subdomain offset
21781# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21782 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
21783# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21784 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
21785# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21786 if (idx < 1 .or. idx > xrows) &
21787# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21788 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21789# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21790 do f = 1, sys_size
21791# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21792 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
21793# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21794 end do
21795# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21796 case (2)
21797# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21798 idx = i + 1 + global_offset_x - index_x
21799# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21800 if (idx < 1 .or. idx > xrows) &
21801# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21802 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21803# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21804 do f = 1, sys_size - 1
21805# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21806 jump = merge(1, 0, f >= eqn_idx%mom%end)
21807# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21808 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
21809# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21810 end do
21811# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21812 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21813# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21814 case (3)
21815# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21816 idx = i + 1 + global_offset_x - index_x
21817# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21818 idy = j + 1 + global_offset_y - index_y
21819# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21820 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
21821# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21822 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
21823# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21824 do f = 1, sys_size - 1
21825# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21826 jump = merge(1, 0, f >= eqn_idx%mom%end)
21827# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21828 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
21829# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21830 end do
21831# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21832 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
21833# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21834 end select
21835# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21836
21837# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21838 y_center = y0_ref
21839# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21840 y_dist = y_cc(j) - y_center
21841# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21842 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
21843# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21844 front_shift = a_param*sin(wave_phase)
21845# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21846
21847# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21848 x_mapped = x_cc(i) - front_shift
21849# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21850
21851# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21852 if (x_mapped <= x_coords(1)) then
21853# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21854 do v = 1, sys_size - 1
21855# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21856 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
21857# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21858 end do
21859# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21860 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21861# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21862 else if (x_mapped >= x_coords(xrows)) then
21863# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21864 do v = 1, sys_size - 1
21865# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21866 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
21867# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21868 end do
21869# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21870 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21871# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21872 else
21873# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21874 idx_lo = 1; idx_hi = xrows
21875# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21876 do while (idx_hi - idx_lo > 1)
21877# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21878 idx_mid = (idx_lo + idx_hi)/2
21879# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21880 if (x_coords(idx_mid) <= x_mapped) then
21881# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21882 idx_lo = idx_mid
21883# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21884 else
21885# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21886 idx_hi = idx_mid
21887# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21888 end if
21889# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21890 end do
21891# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21892
21893# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21894 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
21895# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21896
21897# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21898 do v = 1, sys_size - 1
21899# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21900 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = (1.0_wp - interp_wt)*stored_values(idx_lo, 1, &
21901# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21902 & v) + interp_wt*stored_values(idx_hi, 1, v)
21903# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21904 end do
21905# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21906 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21907# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21908 end if
21909# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21910 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
21911# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21912 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
21913# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21914 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
21915# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21916 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
21917# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21918 d = patch_icpp(patch_id)%a(2) + patch_icpp(patch_id)%a(3)*sin(2._wp*pi*patch_icpp(patch_id)%a(4)*y_cc(j)/(y_domain%end &
21919# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21920 & - y_domain%beg))
21921# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21922 if (x_cc(i) > d) then
21923# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21924 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
21925# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21926 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
21927# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21928 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
21929# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21930 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
21931# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21932 do v = eqn_idx%species%beg, eqn_idx%species%end
21933# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21934 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
21935# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21936 end do
21937# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21938 end if
21939# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21940 case (280) ! Isentropic vortex
21941# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21942 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
21943# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21944 ! geometry 2
21945# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21946 if (patch_id == 1) then
21947# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21948 q_prim_vf(eqn_idx%E)%sf(i, j, &
21949# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21950 & 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) &
21951# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21952 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
21953# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21954 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
21955# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21956 & 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) &
21957# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21958 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
21959# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21960 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
21961# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21962 & 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) &
21963# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21964 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
21965# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21966 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
21967# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21968 & 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) &
21969# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21970 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
21971# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21972 end if
21973# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21974 case (281) ! Acoustic pulse
21975# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21976 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
21977# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21978 ! geometry 2
21979# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21980 if (patch_id == 2) then
21981# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21982 q_prim_vf(eqn_idx%E)%sf(i, j, &
21983# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21984 & 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))
21985# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21986 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
21987# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21988 & 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))
21989# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21990 end if
21991# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21992 case (282) ! Zero-circulation vortex
21993# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21994 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
21995# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21996 ! geometry 2
21997# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21998 if (patch_id == 2) then
21999# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22000 q_prim_vf(eqn_idx%E)%sf(i, j, &
22001# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22002 & 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))
22003# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22004 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
22005# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22006 & 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))
22007# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22008 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
22009# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22010 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
22011# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22012 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
22013# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22014 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
22015# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22016 end if
22017# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22018 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
22019# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22020 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
22021# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22022 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
22023# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22024 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
22025# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22026 ! patch_icpp(patch_id)%epsilon; defaults to 5.
22027# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22028 if (patch_id == 1) then
22029# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22030 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
22031# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22032 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
22033# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22034 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
22035# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22036 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
22037# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22038 do igq = 1, 3
22039# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22040 do jgq = 1, 3
22041# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22042 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
22043# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22044 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
22045# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22046 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
22047# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22048 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))
22049# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22050 wq = gauss_w(igq)*gauss_w(jgq)
22051# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22052 rhoq = t_facq**1.4_wp
22053# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22054 pq = t_facq**2.4_wp
22055# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22056 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
22057# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22058 & - r2q)
22059# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22060 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
22061# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22062 & - r2q)
22063# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22064 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
22065# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22066 rho_avg = rho_avg + wq*rhoq
22067# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22068 rhou_avg = rhou_avg + wq*(rhoq*uq)
22069# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22070 rhov_avg = rhov_avg + wq*(rhoq*vq)
22071# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22072 e_avg = e_avg + wq*eq
22073# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22074 end do
22075# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22076 end do
22077# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22078 rho_avg = rho_avg*0.25_wp
22079# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22080 rhou_avg = rhou_avg*0.25_wp
22081# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22082 rhov_avg = rhov_avg*0.25_wp
22083# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22084 e_avg = e_avg*0.25_wp
22085# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22086 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
22087# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22088 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
22089# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22090 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
22091# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22092 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
22093# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22094 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
22095# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22096 end if
22097# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22098 case (291) ! Isothermal Flat Plate
22099# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22100 t_inf = 1125.0_wp
22101# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22102 t_wall = 600.0_wp
22103# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22104 p_atm = 101325.0_wp
22105# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22106
22107# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22108 ! Boundary/Shear Layer thicknesses
22109# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22110 delta_th = 0.0003_wp ! Thermal BL thickness
22111# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22112 delta_shear = 8e-3_wp ! Velocity BL thickness
22113# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22114
22115# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22116 u_max = 50.0_wp ! Freestream Velocity (m/s)
22117# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22118
22119# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22120 mw_n2 = 28.0134e-3_wp
22121# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22122 mw_o2 = 31.999e-3_wp
22123# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22124 y_n2 = 0.767_wp
22125# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22126 y_o2 = 0.233_wp
22127# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22128 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
22129# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22130 bottom_blend_u = tanh(y_cc(j)/delta_shear)
22131# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22132 bottom_blend_t = tanh(y_cc(j)/delta_th)
22133# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22134 u_mean = u_max*bottom_blend_u
22135# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22136 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
22137# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22138 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
22139# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22140 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
22141# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22142 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
22143# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22144 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
22145# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22146 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
22147# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22148 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
22149# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22150 case default
22151# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22152 if (proc_rank == 0) then
22153# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22154 call s_int_to_str(patch_id, istr)
22155# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22156 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
22157# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22158 end if
22159# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22160 end select
22161 end if
22162
22163 ! Updating the patch identities bookkeeping variable
22164 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
22165
22166 ! Assign Parameters
22167 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
22168 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
22169 q_prim_vf(eqn_idx%E)%sf(i, j, &
22170 & 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, &
22171 & 0)*u0*u0)/16
22172 end if
22173 end do
22174 end do
22175 if (allocated(stored_values)) then
22176# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22177#ifdef MFC_DEBUG
22178# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22179 block
22180# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22181 use iso_fortran_env, only: output_unit
22182# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22183
22184# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22185 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(stored_values)'
22186# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22187
22188# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22189 call flush (output_unit)
22190# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22191 end block
22192# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22193#endif
22194# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22195
22196# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22197#if defined(MFC_OpenACC)
22198# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22199!$acc exit data delete(stored_values)
22200# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22201#elif defined(MFC_OpenMP)
22202# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22203!$omp target exit data map(release:stored_values)
22204# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22205#endif
22206# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22207 deallocate (stored_values)
22208# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22209#ifdef MFC_DEBUG
22210# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22211 block
22212# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22213 use iso_fortran_env, only: output_unit
22214# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22215
22216# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22217 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(x_coords)'
22218# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22219
22220# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22221 call flush (output_unit)
22222# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22223 end block
22224# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22225#endif
22226# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22227
22228# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22229#if defined(MFC_OpenACC)
22230# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22231!$acc exit data delete(x_coords)
22232# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22233#elif defined(MFC_OpenMP)
22234# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22235!$omp target exit data map(release:x_coords)
22236# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22237#endif
22238# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22239 deallocate (x_coords)
22240# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22241 end if
22242# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22243
22244# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22245 if (allocated(y_coords)) then
22246# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22247#ifdef MFC_DEBUG
22248# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22249 block
22250# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22251 use iso_fortran_env, only: output_unit
22252# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22253
22254# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22255 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(y_coords)'
22256# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22257
22258# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22259 call flush (output_unit)
22260# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22261 end block
22262# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22263#endif
22264# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22265
22266# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22267#if defined(MFC_OpenACC)
22268# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22269!$acc exit data delete(y_coords)
22270# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22271#elif defined(MFC_OpenMP)
22272# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22273!$omp target exit data map(release:y_coords)
22274# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22275#endif
22276# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22277 deallocate (y_coords)
22278# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22279 end if
22280# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22281
22282# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22283 files_loaded = .false.
22284# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22285
22286# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22287 if (allocated(stored_values274)) then
22288# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22289#ifdef MFC_DEBUG
22290# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22291 block
22292# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22293 use iso_fortran_env, only: output_unit
22294# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22295
22296# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22297 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(stored_values274)'
22298# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22299
22300# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22301 call flush (output_unit)
22302# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22303 end block
22304# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22305#endif
22306# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22307
22308# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22309#if defined(MFC_OpenACC)
22310# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22311!$acc exit data delete(stored_values274)
22312# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22313#elif defined(MFC_OpenMP)
22314# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22315!$omp target exit data map(release:stored_values274)
22316# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22317#endif
22318# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22319 deallocate (stored_values274)
22320# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22321 end if
22322# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22323
22324# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22325 files_loaded274 = .false.
22326
22327 end subroutine s_icpp_2d_taylorgreen_vortex
22328
22329 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
22330 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
22331
22332 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
22333
22334 ! Patch identifier
22335 integer, intent(in) :: patch_id
22336
22337#ifdef MFC_MIXED_PRECISION
22338 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
22339#else
22340 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
22341#endif
22342 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
22343
22344 ! Generic loop iterators
22345 integer :: i, j, k
22346 ! Placeholders for the cell boundary values
22347
22348 integer :: xRows, yRows, nRows, iix, iiy, max_files
22349# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22350 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
22351# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22352 real(wp) :: x_step, y_step
22353# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22354 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
22355# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22356 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
22357# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22358 real(wp) :: delta_x, delta_y
22359# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22360 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
22361# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22362 real(wp), allocatable :: stored_values(:,:,:)
22363# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22364 real(wp), allocatable :: x_coords(:), y_coords(:)
22365# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22366 logical :: files_loaded = .false.
22367# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22368 real(wp) :: domain_xstart
22369# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22370 character(len=20) :: file_num_str !< For storing the file number as a string
22371# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22372 integer :: ios
22373# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22374 integer :: ios2
22375# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22376
22377# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22378 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
22379# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22380 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
22381# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22382 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
22383# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22384 ! y_coords/files_loaded above.
22385# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22386 real(wp), allocatable, dimension(:,:,:) :: stored_values274
22387# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22388 logical :: files_loaded274 = .false.
22389# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22390 integer :: f274, ix274, iy274, unit274, ios274
22391# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22392 integer :: local_ix_beg274, local_iy_beg274
22393# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22394 character(len=300) :: fname274
22395# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22396 character(len=20) :: file_num_str274
22397# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22398 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
22399# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22400 real(wp) :: file_dx274, file_dy274, r_align274
22401 ! Place any declaration of intermediate variables here
22402# 787 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22403 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
22404
22405 ! Transferring the patch's centroid and length information
22406 x_centroid = patch_icpp(patch_id)%x_centroid
22407 length_x = patch_icpp(patch_id)%length_x
22408
22409 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
22410 x_boundary%beg = x_centroid - 0.5_wp*length_x
22411 x_boundary%end = x_centroid + 0.5_wp*length_x
22412
22413 ! Set eta=1 (no smoothing for this patch type)
22414 eta = 1._wp
22415
22416 ! Assign patch vars if cell is covered and patch has write permission
22417 do i = 0, m
22418 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, &
22419 & 0, 0))) then
22420 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
22421
22422
22423 if (patch_icpp(patch_id)%hcid /= dflt_int) then
22424 select case (patch_icpp(patch_id)%hcid)
22425# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22426 case (150) ! 1D Smooth Alfven Case for MHD
22427# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22428 ! velocity
22429# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22430 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
22431# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22432 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
22433# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22434
22435# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22436 ! magnetic field
22437# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22438 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
22439# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22440 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
22441# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22442 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
22443# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22444 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
22445# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22446 ! SDtoolbox)
22447# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22448 if (.not. files_loaded) then
22449# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22450 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
22451# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22452 do f = 1, max_files
22453# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22454 write (file_num_str, '(I0)') f
22455# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22456 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
22457# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22458 end do
22459# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22460
22461# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22462 ! Common file reading setup
22463# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22464 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22465# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22466 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
22467# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22468
22469# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22470 select case (num_dims)
22471# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22472 case (1, 2) ! 1D and 2D cases are similar
22473# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22474 ! Count lines
22475# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22476 line_count = 0
22477# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22478 do
22479# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22480 read (unit2, *, iostat=ios2) dummy_x, dummy_y
22481# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22482 if (ios2 /= 0) exit
22483# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22484 line_count = line_count + 1
22485# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22486 end do
22487# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22488 close (unit2)
22489# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22490
22491# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22492 xrows = line_count
22493# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22494 yrows = 1
22495# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22496 index_x = 0
22497# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22498 if (num_dims == 2) index_x = i
22499# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22500#ifdef MFC_DEBUG
22501# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22502 block
22503# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22504 use iso_fortran_env, only: output_unit
22505# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22506
22507# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22508 print *, 'm_icpp_patches.fpp:808: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
22509# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22510
22511# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22512 call flush (output_unit)
22513# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22514 end block
22515# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22516#endif
22517# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22518 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
22519# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22520
22521# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22522
22523# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22524
22525# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22526#if defined(MFC_OpenACC)
22527# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22528!$acc enter data create(x_coords, stored_values)
22529# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22530#elif defined(MFC_OpenMP)
22531# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22532!$omp target enter data map(always,alloc:x_coords, stored_values)
22533# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22534#endif
22535# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22536
22537# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22538 ! Read data from all files
22539# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22540 do f = 1, max_files
22541# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22542 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22543# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22544 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22545# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22546
22547# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22548 do iter = 1, xrows
22549# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22550 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
22551# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22552 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
22553# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22554 end do
22555# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22556 close (unit)
22557# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22558 end do
22559# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22560
22561# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22562 ! Calculate offsets
22563# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22564 domain_xstart = x_coords(1)
22565# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22566 x_step = x_cc(1) - x_cc(0)
22567# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22568 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
22569# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22570 global_offset_x = nint(abs(delta_x)/x_step)
22571# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22572 case (3) ! 3D case - determine grid structure
22573# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22574 ! Find yRows by counting rows with same x
22575# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22576 read (unit2, *, iostat=ios2) x0, y0, dummy_z
22577# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22578 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
22579# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22580
22581# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22582 yrows = 1
22583# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22584 do
22585# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22586 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22587# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22588 if (ios2 /= 0) exit
22589# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22590 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
22591# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22592 yrows = yrows + 1
22593# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22594 else
22595# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22596 exit
22597# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22598 end if
22599# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22600 end do
22601# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22602 close (unit2)
22603# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22604
22605# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22606 ! Count total rows
22607# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22608 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22609# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22610 nrows = 0
22611# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22612 do
22613# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22614 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22615# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22616 if (ios2 /= 0) exit
22617# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22618 nrows = nrows + 1
22619# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22620 end do
22621# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22622 close (unit2)
22623# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22624
22625# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22626 xrows = nrows/yrows
22627# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22628#ifdef MFC_DEBUG
22629# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22630 block
22631# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22632 use iso_fortran_env, only: output_unit
22633# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22634
22635# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22636 print *, 'm_icpp_patches.fpp:808: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
22637# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22638
22639# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22640 call flush (output_unit)
22641# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22642 end block
22643# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22644#endif
22645# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22646 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
22647# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22648
22649# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22650
22651# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22652
22653# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22654
22655# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22656#if defined(MFC_OpenACC)
22657# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22658!$acc enter data create(x_coords, y_coords, stored_values)
22659# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22660#elif defined(MFC_OpenMP)
22661# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22662!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
22663# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22664#endif
22665# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22666 index_x = i
22667# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22668 index_y = j
22669# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22670
22671# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22672 ! Read all files
22673# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22674 do f = 1, max_files
22675# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22676 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22677# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22678 if (ios /= 0) then
22679# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22680 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22681# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22682 cycle
22683# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22684 end if
22685# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22686
22687# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22688 iter = 0
22689# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22690 do iix = 1, xrows
22691# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22692 do iiy = 1, yrows
22693# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22694 iter = iter + 1
22695# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22696 if (f == 1) then
22697# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22698 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
22699# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22700 else
22701# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22702 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
22703# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22704 end if
22705# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22706 if (ios /= 0) call s_mpi_abort("Error reading data")
22707# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22708 end do
22709# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22710 end do
22711# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22712 close (unit)
22713# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22714 end do
22715# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22716
22717# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22718 ! Calculate offsets
22719# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22720 x_step = x_cc(1) - x_cc(0)
22721# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22722 y_step = y_cc(1) - y_cc(0)
22723# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22724 delta_x = x_cc(index_x) - x_coords(1)
22725# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22726 delta_y = y_cc(index_y) - y_coords(1)
22727# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22728 global_offset_x = nint(abs(delta_x)/x_step)
22729# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22730 global_offset_y = nint(abs(delta_y)/y_step)
22731# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22732 end select
22733# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22734
22735# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22736 files_loaded = .true.
22737# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22738 end if
22739# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22740
22741# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22742 ! Data assignment
22743# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22744 select case (num_dims)
22745# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22746 case (1)
22747# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22748 idx = i + 1 + global_offset_x
22749# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22750 ! idx must land inside the file's row range: this rank's subdomain offset
22751# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22752 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
22753# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22754 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
22755# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22756 if (idx < 1 .or. idx > xrows) &
22757# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22758 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
22759# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22760 do f = 1, sys_size
22761# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22762 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
22763# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22764 end do
22765# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22766 case (2)
22767# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22768 idx = i + 1 + global_offset_x - index_x
22769# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22770 if (idx < 1 .or. idx > xrows) &
22771# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22772 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
22773# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22774 do f = 1, sys_size - 1
22775# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22776 jump = merge(1, 0, f >= eqn_idx%mom%end)
22777# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22778 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
22779# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22780 end do
22781# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22782 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
22783# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22784 case (3)
22785# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22786 idx = i + 1 + global_offset_x - index_x
22787# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22788 idy = j + 1 + global_offset_y - index_y
22789# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22790 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
22791# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22792 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
22793# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22794 do f = 1, sys_size - 1
22795# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22796 jump = merge(1, 0, f >= eqn_idx%mom%end)
22797# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22798 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
22799# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22800 end do
22801# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22802 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
22803# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22804 end select
22805# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22806 case (180) ! Shu-Osher problem
22807# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22808 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
22809# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22810 ! 0.2*sin(5*x)"
22811# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22812 if (patch_id == 2) then
22813# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22814 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
22815# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22816 end if
22817# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22818 case (181) ! Titarev-Torro problem
22819# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22820 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
22821# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22822 ! "1 + 0.1*sin(20*x*pi)"
22823# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22824 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
22825# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22826 case (182) ! Multi-component diffusion
22827# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22828 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
22829# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22830 x_mid_diffu = 0.05_wp/2.0_wp
22831# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22832 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
22833# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22834 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
22835# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22836 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
22837# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22838 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
22839# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22840 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
22841# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22842
22843# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22844 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
22845# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22846 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
22847# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22848 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
22849# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22850 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
22851# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22852
22853# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22854 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
22855# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22856 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
22857# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22858 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
22859# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22860 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
22861# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22862
22863# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22864 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
22865# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22866
22867# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22868 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
22869# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22870
22871# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22872 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)
22873# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22874 case(191) ! 1D Dual Isothermal case
22875# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22876 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
22877# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22878 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
22879# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22880 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
22881# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22882
22883# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22884 if (x_cc(i) <= 0.025_wp) then
22885# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22886 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
22887# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22888 else
22889# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22890 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
22891# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22892 end if
22893# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22894
22895# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22896 molar_mass_inv = 1.0_wp/2.01588_wp
22897# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22898 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
22899# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22900 case default
22901# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22902 call s_int_to_str(patch_id, istr)
22903# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22904 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
22905# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22906 end select
22907 end if
22908 end if
22909 end do
22910 if (allocated(stored_values)) then
22911# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22912#ifdef MFC_DEBUG
22913# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22914 block
22915# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22916 use iso_fortran_env, only: output_unit
22917# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22918
22919# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22920 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(stored_values)'
22921# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22922
22923# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22924 call flush (output_unit)
22925# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22926 end block
22927# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22928#endif
22929# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22930
22931# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22932#if defined(MFC_OpenACC)
22933# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22934!$acc exit data delete(stored_values)
22935# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22936#elif defined(MFC_OpenMP)
22937# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22938!$omp target exit data map(release:stored_values)
22939# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22940#endif
22941# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22942 deallocate (stored_values)
22943# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22944#ifdef MFC_DEBUG
22945# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22946 block
22947# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22948 use iso_fortran_env, only: output_unit
22949# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22950
22951# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22952 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(x_coords)'
22953# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22954
22955# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22956 call flush (output_unit)
22957# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22958 end block
22959# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22960#endif
22961# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22962
22963# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22964#if defined(MFC_OpenACC)
22965# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22966!$acc exit data delete(x_coords)
22967# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22968#elif defined(MFC_OpenMP)
22969# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22970!$omp target exit data map(release:x_coords)
22971# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22972#endif
22973# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22974 deallocate (x_coords)
22975# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22976 end if
22977# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22978
22979# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22980 if (allocated(y_coords)) then
22981# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22982#ifdef MFC_DEBUG
22983# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22984 block
22985# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22986 use iso_fortran_env, only: output_unit
22987# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22988
22989# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22990 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(y_coords)'
22991# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22992
22993# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22994 call flush (output_unit)
22995# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22996 end block
22997# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22998#endif
22999# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23000
23001# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23002#if defined(MFC_OpenACC)
23003# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23004!$acc exit data delete(y_coords)
23005# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23006#elif defined(MFC_OpenMP)
23007# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23008!$omp target exit data map(release:y_coords)
23009# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23010#endif
23011# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23012 deallocate (y_coords)
23013# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23014 end if
23015# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23016
23017# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23018 files_loaded = .false.
23019# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23020
23021# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23022 if (allocated(stored_values274)) then
23023# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23024#ifdef MFC_DEBUG
23025# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23026 block
23027# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23028 use iso_fortran_env, only: output_unit
23029# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23030
23031# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23032 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(stored_values274)'
23033# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23034
23035# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23036 call flush (output_unit)
23037# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23038 end block
23039# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23040#endif
23041# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23042
23043# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23044#if defined(MFC_OpenACC)
23045# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23046!$acc exit data delete(stored_values274)
23047# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23048#elif defined(MFC_OpenMP)
23049# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23050!$omp target exit data map(release:stored_values274)
23051# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23052#endif
23053# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23054 deallocate (stored_values274)
23055# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23056 end if
23057# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23058
23059# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23060 files_loaded274 = .false.
23061
23062 end subroutine s_icpp_1d_bubble_pulse
23063
23064 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
23065 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
23066 !! 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);
23067 !! coefficients are relative (dimensionless).
23068 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
23069
23070 integer, intent(in) :: patch_id
23071
23072#ifdef MFC_MIXED_PRECISION
23073 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23074#else
23075 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23076#endif
23077 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
23078 real(wp) :: r, theta, R_boundary, sum_series
23079 integer :: i, j, nn
23080
23081 x_centroid = patch_icpp(patch_id)%x_centroid
23082 y_centroid = patch_icpp(patch_id)%y_centroid
23083 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
23084 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
23085 eta = 1._wp
23086
23087 do j = 0, n
23088 do i = 0, m
23089 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
23090 if (r < small_radius) then
23091 theta = 0._wp
23092 else
23093 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
23094 end if
23095 sum_series = 0._wp
23096 do nn = 1, max_2d_fourier_modes
23097 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
23098 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
23099 end do
23100 if (patch_icpp(patch_id)%modal_use_exp_form) then
23101 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
23102 else
23103 r_boundary = patch_icpp(patch_id)%radius + sum_series
23104 r_boundary = max(r_boundary, 0._wp)
23105 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
23106 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
23107 end if
23108 end if
23109 if (patch_icpp(patch_id)%smoothen) then
23110 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx_min, dy_min)*(r_boundary - r))
23111 end if
23112 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
23113 & 0) == smooth_patch_id) then
23114 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
23115 end if
23116 end do
23117 end do
23118
23119 end subroutine s_icpp_2d_modal
23120
23121 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
23122 !! atan2(y,x) relative to centroid.
23123 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
23124
23125 integer, intent(in) :: patch_id
23126
23127#ifdef MFC_MIXED_PRECISION
23128 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23129#else
23130 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23131#endif
23132 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
23133 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
23134 integer :: i, j, k, ll, mm
23135
23136 x_centroid = patch_icpp(patch_id)%x_centroid
23137 y_centroid = patch_icpp(patch_id)%y_centroid
23138 z_centroid = patch_icpp(patch_id)%z_centroid
23139 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
23140 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
23141 eta_local = 1._wp
23142
23143 do k = 0, p
23144 do j = 0, n
23145 do i = 0, m
23146 if (grid_geometry == 3) then
23147 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
23148 dx_loc = x_cc(i) - x_centroid
23149 dy_loc = cart_y - y_centroid
23150 dz_loc = cart_z - z_centroid
23151 else
23152 dx_loc = x_cc(i) - x_centroid
23153 dy_loc = y_cc(j) - y_centroid
23154 dz_loc = z_cc(k) - z_centroid
23155 end if
23156 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
23157 if (r < small_radius) then
23158 theta = 0._wp
23159 phi = 0._wp
23160 else
23161 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
23162 phi = atan2(dy_loc, dx_loc)
23163 end if
23164 r_surface = patch_icpp(patch_id)%radius
23165 do ll = 0, max_sph_harm_degree
23166 do mm = -ll, ll
23167 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
23168 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
23169 end do
23170 end do
23171 if (patch_icpp(patch_id)%smoothen) then
23172 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx_min, dy_min, dz_min)*(r_surface - r))
23173 end if
23174 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
23175 & k) == smooth_patch_id) then
23176 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
23177 end if
23178 end do
23179 end do
23180 end do
23181
23182 end subroutine s_icpp_3d_spherical_harmonic
23183
23184 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
23185 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
23186 !! its boundary.
23187 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
23188
23189 integer, intent(in) :: patch_id
23190
23191#ifdef MFC_MIXED_PRECISION
23192 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23193#else
23194 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
23195#endif
23196 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
23197
23198 ! Generic loop iterators
23199 integer :: i, j, k
23200 real(wp) :: radius
23201
23202 integer :: xRows, yRows, nRows, iix, iiy, max_files
23203# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23204 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
23205# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23206 real(wp) :: x_step, y_step
23207# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23208 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
23209# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23210 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
23211# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23212 real(wp) :: delta_x, delta_y
23213# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23214 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
23215# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23216 real(wp), allocatable :: stored_values(:,:,:)
23217# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23218 real(wp), allocatable :: x_coords(:), y_coords(:)
23219# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23220 logical :: files_loaded = .false.
23221# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23222 real(wp) :: domain_xstart
23223# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23224 character(len=20) :: file_num_str !< For storing the file number as a string
23225# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23226 integer :: ios
23227# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23228 integer :: ios2
23229# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23230
23231# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23232 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
23233# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23234 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
23235# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23236 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
23237# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23238 ! y_coords/files_loaded above.
23239# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23240 real(wp), allocatable, dimension(:,:,:) :: stored_values274
23241# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23242 logical :: files_loaded274 = .false.
23243# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23244 integer :: f274, ix274, iy274, unit274, ios274
23245# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23246 integer :: local_ix_beg274, local_iy_beg274
23247# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23248 character(len=300) :: fname274
23249# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23250 character(len=20) :: file_num_str274
23251# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23252 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
23253# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23254 real(wp) :: file_dx274, file_dy274, r_align274
23255 ! Place any declaration of intermediate variables here
23256# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23257 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
23258# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23259 real(wp) :: eps
23260# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23261
23262# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23263 ! IGR Jets Arrays to stor position and radii of jets from input file
23264# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23265 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
23266# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23267 ! Variables to describe initial condition of jet
23268# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23269 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
23270# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23271 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
23272# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23273 real(wp), dimension(0:n,0:p) :: rcut_arr
23274# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23275 integer :: l, q, s !< Iterators for reading input files
23276# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23277 integer :: start, end !< Ints to keep track of position in file
23278# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23279 character(len=100000) :: line ! String to store line in file
23280# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23281 character(len=25) :: value !< String to store value in line
23282# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23283 integer :: NJet !< Number of jets
23284# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23285 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
23286# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23287 logical :: file_exist ! Flag to check if file exists
23288# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23289
23290# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23291 eps = 1e-9_wp
23292# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23293
23294# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23295 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
23296# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23297 eps_smooth = 3._wp
23298# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23299 inquire (file="njet.txt", exist=file_exist)
23300# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23301 if (file_exist) then
23302# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23303 open (unit=10, file="njet.txt", status="old", action="read")
23304# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23305 read (10, *) njet
23306# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23307 close (10)
23308# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23309 else
23310# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23311 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
23312# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23313 end if
23314# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23315
23316# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23317#ifdef MFC_DEBUG
23318# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23319 block
23320# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23321 use iso_fortran_env, only: output_unit
23322# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23323
23324# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23325 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
23326# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23327
23328# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23329 call flush (output_unit)
23330# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23331 end block
23332# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23333#endif
23334# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23335 allocate (y_th_arr(0:njet - 1))
23336# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23337
23338# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23339
23340# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23341#if defined(MFC_OpenACC)
23342# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23343!$acc enter data create(y_th_arr)
23344# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23345#elif defined(MFC_OpenMP)
23346# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23347!$omp target enter data map(always,alloc:y_th_arr)
23348# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23349#endif
23350# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23351#ifdef MFC_DEBUG
23352# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23353 block
23354# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23355 use iso_fortran_env, only: output_unit
23356# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23357
23358# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23359 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
23360# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23361
23362# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23363 call flush (output_unit)
23364# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23365 end block
23366# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23367#endif
23368# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23369 allocate (z_th_arr(0:njet - 1))
23370# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23371
23372# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23373
23374# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23375#if defined(MFC_OpenACC)
23376# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23377!$acc enter data create(z_th_arr)
23378# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23379#elif defined(MFC_OpenMP)
23380# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23381!$omp target enter data map(always,alloc:z_th_arr)
23382# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23383#endif
23384# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23385#ifdef MFC_DEBUG
23386# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23387 block
23388# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23389 use iso_fortran_env, only: output_unit
23390# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23391
23392# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23393 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
23394# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23395
23396# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23397 call flush (output_unit)
23398# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23399 end block
23400# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23401#endif
23402# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23403 allocate (r_th_arr(0:njet - 1))
23404# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23405
23406# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23407
23408# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23409#if defined(MFC_OpenACC)
23410# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23411!$acc enter data create(r_th_arr)
23412# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23413#elif defined(MFC_OpenMP)
23414# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23415!$omp target enter data map(always,alloc:r_th_arr)
23416# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23417#endif
23418# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23419
23420# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23421 inquire (file="jets.csv", exist=file_exist)
23422# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23423 if (file_exist) then
23424# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23425 open (unit=10, file="jets.csv", status="old", action="read")
23426# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23427 do q = 0, njet - 1
23428# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23429 read (10, '(A)') line ! Read a full line as a string
23430# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23431 start = 1
23432# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23433
23434# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23435 do l = 0, 2
23436# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23437 end = index(line(start:), ',') ! Find the next comma
23438# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23439 if (end == 0) then
23440# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23441 value = trim(adjustl(line(start:))) ! Last value in the line
23442# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23443 else
23444# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23445 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
23446# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23447 start = start + end ! Move to next value
23448# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23449 end if
23450# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23451 if (l == 0) then
23452# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23453 read (value, *) y_th_arr(q) ! Convert string to numeric value
23454# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23455 else if (l == 1) then
23456# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23457 read (value, *) z_th_arr(q)
23458# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23459 else
23460# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23461 read (value, *) r_th_arr(q)
23462# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23463 end if
23464# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23465 end do
23466# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23467 end do
23468# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23469 close (10)
23470# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23471
23472# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23473 do q = 0, p
23474# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23475 do l = 0, n
23476# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23477 rcut = 0._wp
23478# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23479 do s = 0, njet - 1
23480# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23481 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
23482# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23483 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
23484# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23485 end do
23486# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23487 rcut_arr(l, q) = rcut
23488# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23489 end do
23490# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23491 end do
23492# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23493 else
23494# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23495 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
23496# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23497 end if
23498# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23499 end if
23500# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23501
23502# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23503 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
23504# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23505#ifdef MFC_DEBUG
23506# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23507 block
23508# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23509 use iso_fortran_env, only: output_unit
23510# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23511
23512# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23513 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
23514# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23515
23516# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23517 call flush (output_unit)
23518# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23519 end block
23520# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23521#endif
23522# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23523 allocate (ih(0:n_glb, 0:p_glb))
23524# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23525
23526# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23527
23528# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23529#if defined(MFC_OpenACC)
23530# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23531!$acc enter data create(ih)
23532# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23533#elif defined(MFC_OpenMP)
23534# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23535!$omp target enter data map(always,alloc:ih)
23536# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23537#endif
23538# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23539
23540# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23541 if (interface_file == '.') then
23542# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23543 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
23544# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23545 else
23546# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23547 inquire (file=trim(interface_file), exist=file_exist)
23548# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23549 if (file_exist) then
23550# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23551 open (unit=10, file=trim(interface_file), status="old", action="read")
23552# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23553 do i = 0, n_glb
23554# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23555 read (10, '(A)') line ! Read a full line as a string
23556# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23557 start = 1
23558# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23559
23560# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23561 do j = 0, p_glb
23562# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23563 end = index(line(start:), ',') ! Find the next comma
23564# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23565 if (end == 0) then
23566# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23567 value = trim(adjustl(line(start:))) ! Last value in the line
23568# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23569 else
23570# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23571 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
23572# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23573 start = start + end ! Move to next value
23574# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23575 end if
23576# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23577 read (value, *) ih(i, j) ! Convert string to numeric value
23578# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23579 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
23580# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23581 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
23582# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23583 end do
23584# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23585 end do
23586# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23587 close (10)
23588# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23589 else
23590# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23591 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
23592# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23593 end if
23594# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23595 end if
23596# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23597 end if
23598# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23599
23600# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23601 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
23602# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23603#ifdef MFC_DEBUG
23604# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23605 block
23606# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23607 use iso_fortran_env, only: output_unit
23608# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23609
23610# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23611 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
23612# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23613
23614# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23615 call flush (output_unit)
23616# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23617 end block
23618# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23619#endif
23620# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23621 allocate (ih(0:n_glb, 0:0))
23622# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23623
23624# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23625
23626# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23627#if defined(MFC_OpenACC)
23628# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23629!$acc enter data create(ih)
23630# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23631#elif defined(MFC_OpenMP)
23632# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23633!$omp target enter data map(always,alloc:ih)
23634# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23635#endif
23636# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23637 if (interface_file == '.') then
23638# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23639 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
23640# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23641 else
23642# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23643 inquire (file=trim(interface_file), exist=file_exist)
23644# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23645 if (file_exist) then
23646# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23647 open (unit=10, file=trim(interface_file), status="old", action="read")
23648# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23649 do i = 0, n_glb
23650# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23651 read (10, '(A)') line ! Read a full line as a string
23652# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23653 value = trim(line)
23654# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23655 read (value, *) ih(i, 0) ! Convert string to numeric value
23656# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23657 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
23658# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23659 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
23660# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23661 end do
23662# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23663 close (10)
23664# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23665 else
23666# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23667 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
23668# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23669 end if
23670# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23671 end if
23672# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23673 end if
23674
23675 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
23676
23677 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
23678 x_centroid = patch_icpp(patch_id)%x_centroid
23679 y_centroid = patch_icpp(patch_id)%y_centroid
23680 z_centroid = patch_icpp(patch_id)%z_centroid
23681 radius = patch_icpp(patch_id)%radius
23682 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
23683 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
23684
23685 ! Initialize eta=1; modified if smoothing is enabled
23686 eta = 1._wp
23687
23688 ! Assign patch vars if cell is covered and patch has write permission
23689 do k = 0, p
23690 do j = 0, n
23691 do i = 0, m
23692 if (grid_geometry == 3) then
23694 else
23695 cart_y = y_cc(j)
23696 cart_z = z_cc(k)
23697 end if
23698
23699 if (patch_icpp(patch_id)%smoothen) then
23700 eta = tanh(smooth_coeff/min(dx_min, dy_min, &
23701 & dz_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid) &
23702 & **2) - radius))*(-0.5_wp) + 0.5_wp
23703 end if
23704
23705 if ((f_is_inside_sphere(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, &
23706 & radius) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
23707 & k) == smooth_patch_id) then
23708 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
23709
23710
23711 if (patch_icpp(patch_id)%hcid /= dflt_int) then
23712 select case (patch_icpp(patch_id)%hcid)
23713# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23714 case (300) ! Rayleigh-Taylor instability
23715# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23716 rhoh = 3._wp
23717# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23718 rhol = 1._wp
23719# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23720 pref = 1.e5_wp
23721# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23722 pint = pref
23723# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23724 h = 0.7_wp
23725# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23726 lam = 0.2_wp
23727# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23728 wl = 2._wp*pi/lam
23729# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23730 amp = 0.025_wp/wl
23731# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23732
23733# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23734 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
23735# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23736
23737# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23738 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
23739# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23740
23741# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23742 if (alph < eps) alph = eps
23743# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23744 if (alph > 1._wp - eps) alph = 1._wp - eps
23745# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23746
23747# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23748 if (y_cc(j) > inth) then
23749# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23750 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
23751# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23752 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
23753# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23754 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
23755# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23756 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
23757# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23758 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
23759# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23760 else
23761# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23762 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
23763# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23764 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
23765# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23766 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
23767# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23768 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
23769# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23770 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
23771# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23772 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
23773# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23774 end if
23775# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23776 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
23777# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23778 h = 0.0_wp
23779# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23780 lam = 1.0_wp
23781# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23782 amp = patch_icpp(patch_id)%a(2)
23783# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23784 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
23785# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23786 if (x_cc(i) > inth) then
23787# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23788 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
23789# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23790 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
23791# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23792 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
23793# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23794 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
23795# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23796 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
23797# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23798 end if
23799# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23800 case (302) ! 3D Jet with IGR
23801# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23802 ux_th = 10*sqrt(1.4*0.4)
23803# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23804 ux_am = 0.0*sqrt(1.4)
23805# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23806 p_th = 2.0_wp
23807# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23808 p_am = 1.0_wp
23809# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23810 rho_th = 1._wp
23811# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23812 rho_am = 1._wp
23813# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23814 y_th = 0.0_wp
23815# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23816 z_th = 0.0_wp
23817# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23818 r_th = 1._wp
23819# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23820 eps_smooth = 1._wp
23821# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23822 eps = 1e-6
23823# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23824
23825# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23826 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
23827# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23828 rcut = f_cut_on(r - r_th, eps_smooth)
23829# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23830 xcut = f_cut_on(x_cc(i), eps_smooth)
23831# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23832
23833# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23834 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
23835# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23836 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
23837# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23838 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
23839# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23840
23841# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23842 if (num_fluids == 1) then
23843# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23844 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
23845# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23846 else
23847# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23848 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
23849# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23850 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
23851# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23852 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))
23853# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23854 end if
23855# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23856
23857# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23858 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
23859# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23860 case (303) ! 3D Multijet
23861# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23862 eps_smooth = 3.0_wp
23863# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23864 ux_th = 10*sqrt(1.4*0.4)
23865# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23866 ux_am = 2.5*sqrt(1.4*0.4)
23867# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23868 p_th = 0.8_wp
23869# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23870 p_am = 0.4_wp
23871# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23872 rho_th = 1._wp
23873# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23874 rho_am = 1._wp
23875# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23876 eps = 1e-6
23877# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23878
23879# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23880 rcut = rcut_arr(j, k)
23881# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23882 xcut = f_cut_on(x_cc(i), eps_smooth)
23883# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23884
23885# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23886 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
23887# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23888 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
23889# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23890 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
23891# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23892
23893# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23894 if (num_fluids == 1) then
23895# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23896 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
23897# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23898 else
23899# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23900 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
23901# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23902 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
23903# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23904 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))
23905# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23906 end if
23907# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23908
23909# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23910 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
23911# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23912 case (304) ! 3D Interface from file cartesian
23913# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23914 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
23915# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23916
23917# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23918 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
23919# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23920 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
23921# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23922
23923# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23924 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
23925# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23926 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
23927# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23928
23929# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23930 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
23931# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23932 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
23933# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23934
23935# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23936 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
23937# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23938 case (305) ! 3D Interface from file axisymmetric
23939# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23940 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
23941# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23942
23943# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23944 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
23945# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23946 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
23947# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23948
23949# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23950 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
23951# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23952 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
23953# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23954
23955# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23956 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
23957# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23958 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
23959# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23960
23961# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23962 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
23963# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23964 case (370) ! 3D extrusion of 2D profile from external data
23965# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23966 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
23967# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23968 if (.not. files_loaded) then
23969# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23970 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
23971# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23972 do f = 1, max_files
23973# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23974 write (file_num_str, '(I0)') f
23975# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23976 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
23977# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23978 end do
23979# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23980
23981# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23982 ! Common file reading setup
23983# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23984 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
23985# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23986 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
23987# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23988
23989# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23990 select case (num_dims)
23991# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23992 case (1, 2) ! 1D and 2D cases are similar
23993# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23994 ! Count lines
23995# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23996 line_count = 0
23997# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23998 do
23999# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24000 read (unit2, *, iostat=ios2) dummy_x, dummy_y
24001# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24002 if (ios2 /= 0) exit
24003# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24004 line_count = line_count + 1
24005# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24006 end do
24007# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24008 close (unit2)
24009# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24010
24011# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24012 xrows = line_count
24013# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24014 yrows = 1
24015# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24016 index_x = 0
24017# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24018 if (num_dims == 2) index_x = i
24019# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24020#ifdef MFC_DEBUG
24021# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24022 block
24023# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24024 use iso_fortran_env, only: output_unit
24025# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24026
24027# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24028 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
24029# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24030
24031# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24032 call flush (output_unit)
24033# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24034 end block
24035# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24036#endif
24037# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24038 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
24039# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24040
24041# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24042
24043# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24044
24045# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24046#if defined(MFC_OpenACC)
24047# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24048!$acc enter data create(x_coords, stored_values)
24049# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24050#elif defined(MFC_OpenMP)
24051# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24052!$omp target enter data map(always,alloc:x_coords, stored_values)
24053# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24054#endif
24055# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24056
24057# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24058 ! Read data from all files
24059# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24060 do f = 1, max_files
24061# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24062 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
24063# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24064 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
24065# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24066
24067# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24068 do iter = 1, xrows
24069# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24070 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
24071# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24072 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
24073# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24074 end do
24075# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24076 close (unit)
24077# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24078 end do
24079# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24080
24081# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24082 ! Calculate offsets
24083# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24084 domain_xstart = x_coords(1)
24085# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24086 x_step = x_cc(1) - x_cc(0)
24087# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24088 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
24089# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24090 global_offset_x = nint(abs(delta_x)/x_step)
24091# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24092 case (3) ! 3D case - determine grid structure
24093# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24094 ! Find yRows by counting rows with same x
24095# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24096 read (unit2, *, iostat=ios2) x0, y0, dummy_z
24097# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24098 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
24099# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24100
24101# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24102 yrows = 1
24103# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24104 do
24105# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24106 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
24107# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24108 if (ios2 /= 0) exit
24109# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24110 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
24111# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24112 yrows = yrows + 1
24113# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24114 else
24115# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24116 exit
24117# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24118 end if
24119# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24120 end do
24121# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24122 close (unit2)
24123# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24124
24125# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24126 ! Count total rows
24127# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24128 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
24129# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24130 nrows = 0
24131# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24132 do
24133# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24134 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
24135# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24136 if (ios2 /= 0) exit
24137# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24138 nrows = nrows + 1
24139# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24140 end do
24141# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24142 close (unit2)
24143# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24144
24145# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24146 xrows = nrows/yrows
24147# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24148#ifdef MFC_DEBUG
24149# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24150 block
24151# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24152 use iso_fortran_env, only: output_unit
24153# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24154
24155# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24156 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
24157# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24158
24159# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24160 call flush (output_unit)
24161# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24162 end block
24163# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24164#endif
24165# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24166 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
24167# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24168
24169# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24170
24171# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24172
24173# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24174
24175# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24176#if defined(MFC_OpenACC)
24177# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24178!$acc enter data create(x_coords, y_coords, stored_values)
24179# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24180#elif defined(MFC_OpenMP)
24181# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24182!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
24183# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24184#endif
24185# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24186 index_x = i
24187# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24188 index_y = j
24189# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24190
24191# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24192 ! Read all files
24193# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24194 do f = 1, max_files
24195# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24196 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
24197# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24198 if (ios /= 0) then
24199# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24200 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
24201# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24202 cycle
24203# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24204 end if
24205# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24206
24207# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24208 iter = 0
24209# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24210 do iix = 1, xrows
24211# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24212 do iiy = 1, yrows
24213# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24214 iter = iter + 1
24215# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24216 if (f == 1) then
24217# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24218 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
24219# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24220 else
24221# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24222 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
24223# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24224 end if
24225# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24226 if (ios /= 0) call s_mpi_abort("Error reading data")
24227# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24228 end do
24229# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24230 end do
24231# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24232 close (unit)
24233# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24234 end do
24235# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24236
24237# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24238 ! Calculate offsets
24239# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24240 x_step = x_cc(1) - x_cc(0)
24241# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24242 y_step = y_cc(1) - y_cc(0)
24243# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24244 delta_x = x_cc(index_x) - x_coords(1)
24245# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24246 delta_y = y_cc(index_y) - y_coords(1)
24247# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24248 global_offset_x = nint(abs(delta_x)/x_step)
24249# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24250 global_offset_y = nint(abs(delta_y)/y_step)
24251# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24252 end select
24253# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24254
24255# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24256 files_loaded = .true.
24257# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24258 end if
24259# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24260
24261# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24262 ! Data assignment
24263# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24264 select case (num_dims)
24265# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24266 case (1)
24267# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24268 idx = i + 1 + global_offset_x
24269# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24270 ! idx must land inside the file's row range: this rank's subdomain offset
24271# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24272 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
24273# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24274 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
24275# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24276 if (idx < 1 .or. idx > xrows) &
24277# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24278 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
24279# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24280 do f = 1, sys_size
24281# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24282 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
24283# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24284 end do
24285# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24286 case (2)
24287# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24288 idx = i + 1 + global_offset_x - index_x
24289# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24290 if (idx < 1 .or. idx > xrows) &
24291# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24292 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
24293# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24294 do f = 1, sys_size - 1
24295# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24296 jump = merge(1, 0, f >= eqn_idx%mom%end)
24297# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24298 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
24299# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24300 end do
24301# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24302 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24303# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24304 case (3)
24305# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24306 idx = i + 1 + global_offset_x - index_x
24307# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24308 idy = j + 1 + global_offset_y - index_y
24309# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24310 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
24311# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24312 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
24313# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24314 do f = 1, sys_size - 1
24315# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24316 jump = merge(1, 0, f >= eqn_idx%mom%end)
24317# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24318 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
24319# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24320 end do
24321# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24322 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
24323# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24324 end select
24325# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24326 case (380) ! Taylor-Green vortex
24327# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24328 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
24329# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24330 ! geometry 9
24331# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24332 mach = 0.1
24333# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24334 if (patch_id == 1) then
24335# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24336 q_prim_vf(eqn_idx%E)%sf(i, j, &
24337# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24338 & 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)
24339# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24340 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)
24341# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24342 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)
24343# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24344 end if
24345# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24346 case default
24347# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24348 call s_int_to_str(patch_id, istr)
24349# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24350 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
24351# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24352 end select
24353 end if
24354 end if
24355 end do
24356 end do
24357 end do
24358 if (allocated(stored_values)) then
24359# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24360#ifdef MFC_DEBUG
24361# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24362 block
24363# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24364 use iso_fortran_env, only: output_unit
24365# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24366
24367# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24368 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(stored_values)'
24369# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24370
24371# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24372 call flush (output_unit)
24373# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24374 end block
24375# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24376#endif
24377# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24378
24379# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24380#if defined(MFC_OpenACC)
24381# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24382!$acc exit data delete(stored_values)
24383# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24384#elif defined(MFC_OpenMP)
24385# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24386!$omp target exit data map(release:stored_values)
24387# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24388#endif
24389# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24390 deallocate (stored_values)
24391# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24392#ifdef MFC_DEBUG
24393# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24394 block
24395# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24396 use iso_fortran_env, only: output_unit
24397# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24398
24399# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24400 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(x_coords)'
24401# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24402
24403# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24404 call flush (output_unit)
24405# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24406 end block
24407# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24408#endif
24409# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24410
24411# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24412#if defined(MFC_OpenACC)
24413# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24414!$acc exit data delete(x_coords)
24415# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24416#elif defined(MFC_OpenMP)
24417# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24418!$omp target exit data map(release:x_coords)
24419# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24420#endif
24421# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24422 deallocate (x_coords)
24423# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24424 end if
24425# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24426
24427# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24428 if (allocated(y_coords)) then
24429# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24430#ifdef MFC_DEBUG
24431# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24432 block
24433# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24434 use iso_fortran_env, only: output_unit
24435# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24436
24437# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24438 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(y_coords)'
24439# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24440
24441# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24442 call flush (output_unit)
24443# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24444 end block
24445# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24446#endif
24447# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24448
24449# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24450#if defined(MFC_OpenACC)
24451# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24452!$acc exit data delete(y_coords)
24453# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24454#elif defined(MFC_OpenMP)
24455# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24456!$omp target exit data map(release:y_coords)
24457# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24458#endif
24459# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24460 deallocate (y_coords)
24461# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24462 end if
24463# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24464
24465# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24466 files_loaded = .false.
24467# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24468
24469# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24470 if (allocated(stored_values274)) then
24471# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24472#ifdef MFC_DEBUG
24473# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24474 block
24475# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24476 use iso_fortran_env, only: output_unit
24477# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24478
24479# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24480 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(stored_values274)'
24481# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24482
24483# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24484 call flush (output_unit)
24485# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24486 end block
24487# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24488#endif
24489# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24490
24491# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24492#if defined(MFC_OpenACC)
24493# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24494!$acc exit data delete(stored_values274)
24495# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24496#elif defined(MFC_OpenMP)
24497# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24498!$omp target exit data map(release:stored_values274)
24499# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24500#endif
24501# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24502 deallocate (stored_values274)
24503# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24504 end if
24505# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24506
24507# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24508 files_loaded274 = .false.
24509
24510 end subroutine s_icpp_sphere
24511
24512 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
24513 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
24514 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
24515 !! allow for the smearing of its boundaries.
24516 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
24517
24518 integer, intent(in) :: patch_id
24519
24520#ifdef MFC_MIXED_PRECISION
24521 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
24522#else
24523 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
24524#endif
24525 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
24526 integer :: i, j, k !< Generic loop iterators
24527
24528 integer :: xRows, yRows, nRows, iix, iiy, max_files
24529# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24530 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
24531# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24532 real(wp) :: x_step, y_step
24533# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24534 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
24535# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24536 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
24537# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24538 real(wp) :: delta_x, delta_y
24539# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24540 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
24541# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24542 real(wp), allocatable :: stored_values(:,:,:)
24543# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24544 real(wp), allocatable :: x_coords(:), y_coords(:)
24545# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24546 logical :: files_loaded = .false.
24547# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24548 real(wp) :: domain_xstart
24549# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24550 character(len=20) :: file_num_str !< For storing the file number as a string
24551# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24552 integer :: ios
24553# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24554 integer :: ios2
24555# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24556
24557# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24558 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
24559# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24560 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
24561# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24562 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
24563# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24564 ! y_coords/files_loaded above.
24565# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24566 real(wp), allocatable, dimension(:,:,:) :: stored_values274
24567# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24568 logical :: files_loaded274 = .false.
24569# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24570 integer :: f274, ix274, iy274, unit274, ios274
24571# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24572 integer :: local_ix_beg274, local_iy_beg274
24573# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24574 character(len=300) :: fname274
24575# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24576 character(len=20) :: file_num_str274
24577# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24578 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
24579# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24580 real(wp) :: file_dx274, file_dy274, r_align274
24581 ! Place any declaration of intermediate variables here
24582# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24583 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
24584# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24585 real(wp) :: eps
24586# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24587
24588# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24589 ! IGR Jets Arrays to stor position and radii of jets from input file
24590# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24591 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
24592# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24593 ! Variables to describe initial condition of jet
24594# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24595 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
24596# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24597 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
24598# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24599 real(wp), dimension(0:n,0:p) :: rcut_arr
24600# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24601 integer :: l, q, s !< Iterators for reading input files
24602# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24603 integer :: start, end !< Ints to keep track of position in file
24604# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24605 character(len=100000) :: line ! String to store line in file
24606# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24607 character(len=25) :: value !< String to store value in line
24608# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24609 integer :: NJet !< Number of jets
24610# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24611 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
24612# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24613 logical :: file_exist ! Flag to check if file exists
24614# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24615
24616# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24617 eps = 1e-9_wp
24618# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24619
24620# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24621 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
24622# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24623 eps_smooth = 3._wp
24624# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24625 inquire (file="njet.txt", exist=file_exist)
24626# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24627 if (file_exist) then
24628# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24629 open (unit=10, file="njet.txt", status="old", action="read")
24630# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24631 read (10, *) njet
24632# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24633 close (10)
24634# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24635 else
24636# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24637 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
24638# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24639 end if
24640# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24641
24642# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24643#ifdef MFC_DEBUG
24644# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24645 block
24646# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24647 use iso_fortran_env, only: output_unit
24648# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24649
24650# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24651 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
24652# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24653
24654# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24655 call flush (output_unit)
24656# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24657 end block
24658# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24659#endif
24660# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24661 allocate (y_th_arr(0:njet - 1))
24662# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24663
24664# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24665
24666# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24667#if defined(MFC_OpenACC)
24668# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24669!$acc enter data create(y_th_arr)
24670# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24671#elif defined(MFC_OpenMP)
24672# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24673!$omp target enter data map(always,alloc:y_th_arr)
24674# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24675#endif
24676# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24677#ifdef MFC_DEBUG
24678# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24679 block
24680# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24681 use iso_fortran_env, only: output_unit
24682# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24683
24684# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24685 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
24686# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24687
24688# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24689 call flush (output_unit)
24690# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24691 end block
24692# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24693#endif
24694# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24695 allocate (z_th_arr(0:njet - 1))
24696# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24697
24698# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24699
24700# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24701#if defined(MFC_OpenACC)
24702# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24703!$acc enter data create(z_th_arr)
24704# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24705#elif defined(MFC_OpenMP)
24706# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24707!$omp target enter data map(always,alloc:z_th_arr)
24708# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24709#endif
24710# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24711#ifdef MFC_DEBUG
24712# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24713 block
24714# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24715 use iso_fortran_env, only: output_unit
24716# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24717
24718# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24719 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
24720# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24721
24722# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24723 call flush (output_unit)
24724# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24725 end block
24726# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24727#endif
24728# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24729 allocate (r_th_arr(0:njet - 1))
24730# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24731
24732# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24733
24734# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24735#if defined(MFC_OpenACC)
24736# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24737!$acc enter data create(r_th_arr)
24738# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24739#elif defined(MFC_OpenMP)
24740# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24741!$omp target enter data map(always,alloc:r_th_arr)
24742# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24743#endif
24744# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24745
24746# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24747 inquire (file="jets.csv", exist=file_exist)
24748# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24749 if (file_exist) then
24750# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24751 open (unit=10, file="jets.csv", status="old", action="read")
24752# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24753 do q = 0, njet - 1
24754# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24755 read (10, '(A)') line ! Read a full line as a string
24756# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24757 start = 1
24758# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24759
24760# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24761 do l = 0, 2
24762# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24763 end = index(line(start:), ',') ! Find the next comma
24764# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24765 if (end == 0) then
24766# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24767 value = trim(adjustl(line(start:))) ! Last value in the line
24768# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24769 else
24770# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24771 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
24772# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24773 start = start + end ! Move to next value
24774# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24775 end if
24776# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24777 if (l == 0) then
24778# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24779 read (value, *) y_th_arr(q) ! Convert string to numeric value
24780# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24781 else if (l == 1) then
24782# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24783 read (value, *) z_th_arr(q)
24784# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24785 else
24786# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24787 read (value, *) r_th_arr(q)
24788# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24789 end if
24790# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24791 end do
24792# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24793 end do
24794# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24795 close (10)
24796# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24797
24798# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24799 do q = 0, p
24800# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24801 do l = 0, n
24802# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24803 rcut = 0._wp
24804# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24805 do s = 0, njet - 1
24806# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24807 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
24808# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24809 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
24810# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24811 end do
24812# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24813 rcut_arr(l, q) = rcut
24814# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24815 end do
24816# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24817 end do
24818# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24819 else
24820# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24821 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
24822# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24823 end if
24824# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24825 end if
24826# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24827
24828# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24829 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
24830# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24831#ifdef MFC_DEBUG
24832# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24833 block
24834# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24835 use iso_fortran_env, only: output_unit
24836# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24837
24838# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24839 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
24840# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24841
24842# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24843 call flush (output_unit)
24844# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24845 end block
24846# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24847#endif
24848# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24849 allocate (ih(0:n_glb, 0:p_glb))
24850# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24851
24852# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24853
24854# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24855#if defined(MFC_OpenACC)
24856# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24857!$acc enter data create(ih)
24858# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24859#elif defined(MFC_OpenMP)
24860# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24861!$omp target enter data map(always,alloc:ih)
24862# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24863#endif
24864# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24865
24866# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24867 if (interface_file == '.') then
24868# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24869 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
24870# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24871 else
24872# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24873 inquire (file=trim(interface_file), exist=file_exist)
24874# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24875 if (file_exist) then
24876# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24877 open (unit=10, file=trim(interface_file), status="old", action="read")
24878# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24879 do i = 0, n_glb
24880# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24881 read (10, '(A)') line ! Read a full line as a string
24882# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24883 start = 1
24884# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24885
24886# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24887 do j = 0, p_glb
24888# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24889 end = index(line(start:), ',') ! Find the next comma
24890# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24891 if (end == 0) then
24892# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24893 value = trim(adjustl(line(start:))) ! Last value in the line
24894# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24895 else
24896# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24897 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
24898# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24899 start = start + end ! Move to next value
24900# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24901 end if
24902# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24903 read (value, *) ih(i, j) ! Convert string to numeric value
24904# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24905 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
24906# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24907 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
24908# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24909 end do
24910# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24911 end do
24912# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24913 close (10)
24914# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24915 else
24916# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24917 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
24918# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24919 end if
24920# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24921 end if
24922# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24923 end if
24924# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24925
24926# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24927 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
24928# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24929#ifdef MFC_DEBUG
24930# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24931 block
24932# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24933 use iso_fortran_env, only: output_unit
24934# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24935
24936# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24937 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
24938# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24939
24940# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24941 call flush (output_unit)
24942# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24943 end block
24944# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24945#endif
24946# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24947 allocate (ih(0:n_glb, 0:0))
24948# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24949
24950# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24951
24952# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24953#if defined(MFC_OpenACC)
24954# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24955!$acc enter data create(ih)
24956# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24957#elif defined(MFC_OpenMP)
24958# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24959!$omp target enter data map(always,alloc:ih)
24960# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24961#endif
24962# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24963 if (interface_file == '.') then
24964# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24965 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
24966# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24967 else
24968# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24969 inquire (file=trim(interface_file), exist=file_exist)
24970# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24971 if (file_exist) then
24972# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24973 open (unit=10, file=trim(interface_file), status="old", action="read")
24974# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24975 do i = 0, n_glb
24976# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24977 read (10, '(A)') line ! Read a full line as a string
24978# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24979 value = trim(line)
24980# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24981 read (value, *) ih(i, 0) ! Convert string to numeric value
24982# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24983 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
24984# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24985 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
24986# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24987 end do
24988# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24989 close (10)
24990# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24991 else
24992# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24993 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
24994# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24995 end if
24996# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24997 end if
24998# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24999 end if
25000
25001 ! Transferring the cuboid's centroid and length information
25002 x_centroid = patch_icpp(patch_id)%x_centroid
25003 y_centroid = patch_icpp(patch_id)%y_centroid
25004 z_centroid = patch_icpp(patch_id)%z_centroid
25005 length_x = patch_icpp(patch_id)%length_x
25006 length_y = patch_icpp(patch_id)%length_y
25007 length_z = patch_icpp(patch_id)%length_z
25008
25009 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
25010 x_boundary%beg = x_centroid - 0.5_wp*length_x
25011 x_boundary%end = x_centroid + 0.5_wp*length_x
25012 y_boundary%beg = y_centroid - 0.5_wp*length_y
25013 y_boundary%end = y_centroid + 0.5_wp*length_y
25014 z_boundary%beg = z_centroid - 0.5_wp*length_z
25015 z_boundary%end = z_centroid + 0.5_wp*length_z
25016
25017 ! Set eta=1 (no smoothing for this patch type)
25018 eta = 1._wp
25019
25020 ! Assign patch vars if cell is covered and patch has write permission
25021 do k = 0, p
25022 do j = 0, n
25023 do i = 0, m
25024 if (grid_geometry == 3) then
25026 else
25027 cart_y = y_cc(j)
25028 cart_z = z_cc(k)
25029 end if
25030
25031 if (f_is_inside_cuboid(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, [length_x, length_y, &
25032 & length_z])) then
25033 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
25034 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
25035
25036
25037 if (patch_icpp(patch_id)%hcid /= dflt_int) then
25038 select case (patch_icpp(patch_id)%hcid)
25039# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25040 case (300) ! Rayleigh-Taylor instability
25041# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25042 rhoh = 3._wp
25043# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25044 rhol = 1._wp
25045# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25046 pref = 1.e5_wp
25047# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25048 pint = pref
25049# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25050 h = 0.7_wp
25051# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25052 lam = 0.2_wp
25053# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25054 wl = 2._wp*pi/lam
25055# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25056 amp = 0.025_wp/wl
25057# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25058
25059# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25060 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
25061# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25062
25063# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25064 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
25065# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25066
25067# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25068 if (alph < eps) alph = eps
25069# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25070 if (alph > 1._wp - eps) alph = 1._wp - eps
25071# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25072
25073# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25074 if (y_cc(j) > inth) then
25075# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25076 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
25077# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25078 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
25079# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25080 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
25081# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25082 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
25083# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25084 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
25085# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25086 else
25087# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25088 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
25089# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25090 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
25091# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25092 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
25093# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25094 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
25095# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25096 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
25097# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25098 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
25099# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25100 end if
25101# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25102 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
25103# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25104 h = 0.0_wp
25105# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25106 lam = 1.0_wp
25107# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25108 amp = patch_icpp(patch_id)%a(2)
25109# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25110 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
25111# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25112 if (x_cc(i) > inth) then
25113# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25114 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
25115# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25116 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
25117# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25118 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
25119# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25120 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
25121# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25122 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
25123# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25124 end if
25125# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25126 case (302) ! 3D Jet with IGR
25127# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25128 ux_th = 10*sqrt(1.4*0.4)
25129# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25130 ux_am = 0.0*sqrt(1.4)
25131# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25132 p_th = 2.0_wp
25133# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25134 p_am = 1.0_wp
25135# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25136 rho_th = 1._wp
25137# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25138 rho_am = 1._wp
25139# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25140 y_th = 0.0_wp
25141# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25142 z_th = 0.0_wp
25143# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25144 r_th = 1._wp
25145# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25146 eps_smooth = 1._wp
25147# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25148 eps = 1e-6
25149# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25150
25151# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25152 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
25153# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25154 rcut = f_cut_on(r - r_th, eps_smooth)
25155# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25156 xcut = f_cut_on(x_cc(i), eps_smooth)
25157# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25158
25159# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25160 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
25161# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25162 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
25163# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25164 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
25165# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25166
25167# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25168 if (num_fluids == 1) then
25169# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25170 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
25171# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25172 else
25173# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25174 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
25175# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25176 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
25177# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25178 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))
25179# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25180 end if
25181# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25182
25183# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25184 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
25185# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25186 case (303) ! 3D Multijet
25187# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25188 eps_smooth = 3.0_wp
25189# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25190 ux_th = 10*sqrt(1.4*0.4)
25191# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25192 ux_am = 2.5*sqrt(1.4*0.4)
25193# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25194 p_th = 0.8_wp
25195# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25196 p_am = 0.4_wp
25197# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25198 rho_th = 1._wp
25199# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25200 rho_am = 1._wp
25201# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25202 eps = 1e-6
25203# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25204
25205# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25206 rcut = rcut_arr(j, k)
25207# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25208 xcut = f_cut_on(x_cc(i), eps_smooth)
25209# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25210
25211# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25212 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
25213# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25214 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
25215# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25216 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
25217# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25218
25219# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25220 if (num_fluids == 1) then
25221# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25222 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
25223# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25224 else
25225# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25226 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
25227# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25228 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
25229# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25230 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))
25231# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25232 end if
25233# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25234
25235# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25236 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
25237# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25238 case (304) ! 3D Interface from file cartesian
25239# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25240 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
25241# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25242
25243# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25244 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
25245# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25246 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
25247# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25248
25249# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25250 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
25251# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25252 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
25253# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25254
25255# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25256 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
25257# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25258 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
25259# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25260
25261# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25262 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
25263# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25264 case (305) ! 3D Interface from file axisymmetric
25265# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25266 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
25267# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25268
25269# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25270 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
25271# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25272 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
25273# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25274
25275# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25276 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
25277# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25278 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
25279# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25280
25281# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25282 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
25283# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25284 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
25285# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25286
25287# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25288 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
25289# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25290 case (370) ! 3D extrusion of 2D profile from external data
25291# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25292 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
25293# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25294 if (.not. files_loaded) then
25295# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25296 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
25297# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25298 do f = 1, max_files
25299# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25300 write (file_num_str, '(I0)') f
25301# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25302 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
25303# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25304 end do
25305# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25306
25307# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25308 ! Common file reading setup
25309# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25310 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
25311# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25312 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
25313# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25314
25315# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25316 select case (num_dims)
25317# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25318 case (1, 2) ! 1D and 2D cases are similar
25319# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25320 ! Count lines
25321# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25322 line_count = 0
25323# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25324 do
25325# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25326 read (unit2, *, iostat=ios2) dummy_x, dummy_y
25327# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25328 if (ios2 /= 0) exit
25329# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25330 line_count = line_count + 1
25331# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25332 end do
25333# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25334 close (unit2)
25335# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25336
25337# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25338 xrows = line_count
25339# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25340 yrows = 1
25341# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25342 index_x = 0
25343# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25344 if (num_dims == 2) index_x = i
25345# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25346#ifdef MFC_DEBUG
25347# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25348 block
25349# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25350 use iso_fortran_env, only: output_unit
25351# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25352
25353# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25354 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
25355# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25356
25357# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25358 call flush (output_unit)
25359# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25360 end block
25361# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25362#endif
25363# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25364 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
25365# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25366
25367# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25368
25369# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25370
25371# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25372#if defined(MFC_OpenACC)
25373# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25374!$acc enter data create(x_coords, stored_values)
25375# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25376#elif defined(MFC_OpenMP)
25377# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25378!$omp target enter data map(always,alloc:x_coords, stored_values)
25379# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25380#endif
25381# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25382
25383# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25384 ! Read data from all files
25385# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25386 do f = 1, max_files
25387# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25388 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
25389# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25390 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
25391# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25392
25393# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25394 do iter = 1, xrows
25395# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25396 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
25397# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25398 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
25399# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25400 end do
25401# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25402 close (unit)
25403# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25404 end do
25405# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25406
25407# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25408 ! Calculate offsets
25409# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25410 domain_xstart = x_coords(1)
25411# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25412 x_step = x_cc(1) - x_cc(0)
25413# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25414 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
25415# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25416 global_offset_x = nint(abs(delta_x)/x_step)
25417# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25418 case (3) ! 3D case - determine grid structure
25419# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25420 ! Find yRows by counting rows with same x
25421# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25422 read (unit2, *, iostat=ios2) x0, y0, dummy_z
25423# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25424 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
25425# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25426
25427# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25428 yrows = 1
25429# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25430 do
25431# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25432 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
25433# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25434 if (ios2 /= 0) exit
25435# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25436 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
25437# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25438 yrows = yrows + 1
25439# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25440 else
25441# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25442 exit
25443# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25444 end if
25445# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25446 end do
25447# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25448 close (unit2)
25449# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25450
25451# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25452 ! Count total rows
25453# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25454 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
25455# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25456 nrows = 0
25457# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25458 do
25459# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25460 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
25461# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25462 if (ios2 /= 0) exit
25463# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25464 nrows = nrows + 1
25465# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25466 end do
25467# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25468 close (unit2)
25469# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25470
25471# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25472 xrows = nrows/yrows
25473# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25474#ifdef MFC_DEBUG
25475# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25476 block
25477# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25478 use iso_fortran_env, only: output_unit
25479# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25480
25481# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25482 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
25483# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25484
25485# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25486 call flush (output_unit)
25487# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25488 end block
25489# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25490#endif
25491# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25492 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
25493# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25494
25495# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25496
25497# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25498
25499# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25500
25501# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25502#if defined(MFC_OpenACC)
25503# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25504!$acc enter data create(x_coords, y_coords, stored_values)
25505# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25506#elif defined(MFC_OpenMP)
25507# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25508!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
25509# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25510#endif
25511# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25512 index_x = i
25513# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25514 index_y = j
25515# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25516
25517# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25518 ! Read all files
25519# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25520 do f = 1, max_files
25521# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25522 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
25523# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25524 if (ios /= 0) then
25525# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25526 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
25527# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25528 cycle
25529# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25530 end if
25531# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25532
25533# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25534 iter = 0
25535# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25536 do iix = 1, xrows
25537# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25538 do iiy = 1, yrows
25539# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25540 iter = iter + 1
25541# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25542 if (f == 1) then
25543# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25544 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
25545# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25546 else
25547# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25548 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
25549# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25550 end if
25551# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25552 if (ios /= 0) call s_mpi_abort("Error reading data")
25553# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25554 end do
25555# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25556 end do
25557# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25558 close (unit)
25559# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25560 end do
25561# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25562
25563# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25564 ! Calculate offsets
25565# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25566 x_step = x_cc(1) - x_cc(0)
25567# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25568 y_step = y_cc(1) - y_cc(0)
25569# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25570 delta_x = x_cc(index_x) - x_coords(1)
25571# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25572 delta_y = y_cc(index_y) - y_coords(1)
25573# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25574 global_offset_x = nint(abs(delta_x)/x_step)
25575# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25576 global_offset_y = nint(abs(delta_y)/y_step)
25577# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25578 end select
25579# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25580
25581# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25582 files_loaded = .true.
25583# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25584 end if
25585# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25586
25587# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25588 ! Data assignment
25589# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25590 select case (num_dims)
25591# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25592 case (1)
25593# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25594 idx = i + 1 + global_offset_x
25595# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25596 ! idx must land inside the file's row range: this rank's subdomain offset
25597# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25598 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
25599# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25600 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
25601# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25602 if (idx < 1 .or. idx > xrows) &
25603# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25604 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
25605# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25606 do f = 1, sys_size
25607# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25608 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
25609# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25610 end do
25611# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25612 case (2)
25613# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25614 idx = i + 1 + global_offset_x - index_x
25615# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25616 if (idx < 1 .or. idx > xrows) &
25617# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25618 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
25619# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25620 do f = 1, sys_size - 1
25621# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25622 jump = merge(1, 0, f >= eqn_idx%mom%end)
25623# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25624 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
25625# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25626 end do
25627# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25628 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
25629# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25630 case (3)
25631# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25632 idx = i + 1 + global_offset_x - index_x
25633# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25634 idy = j + 1 + global_offset_y - index_y
25635# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25636 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
25637# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25638 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
25639# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25640 do f = 1, sys_size - 1
25641# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25642 jump = merge(1, 0, f >= eqn_idx%mom%end)
25643# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25644 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
25645# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25646 end do
25647# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25648 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
25649# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25650 end select
25651# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25652 case (380) ! Taylor-Green vortex
25653# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25654 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
25655# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25656 ! geometry 9
25657# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25658 mach = 0.1
25659# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25660 if (patch_id == 1) then
25661# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25662 q_prim_vf(eqn_idx%E)%sf(i, j, &
25663# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25664 & 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)
25665# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25666 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)
25667# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25668 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)
25669# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25670 end if
25671# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25672 case default
25673# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25674 call s_int_to_str(patch_id, istr)
25675# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25676 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
25677# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25678 end select
25679 end if
25680
25681 ! Updating the patch identities bookkeeping variable
25682 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
25683 end if
25684 end if
25685 end do
25686 end do
25687 end do
25688 if (allocated(stored_values)) then
25689# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25690#ifdef MFC_DEBUG
25691# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25692 block
25693# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25694 use iso_fortran_env, only: output_unit
25695# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25696
25697# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25698 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(stored_values)'
25699# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25700
25701# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25702 call flush (output_unit)
25703# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25704 end block
25705# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25706#endif
25707# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25708
25709# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25710#if defined(MFC_OpenACC)
25711# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25712!$acc exit data delete(stored_values)
25713# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25714#elif defined(MFC_OpenMP)
25715# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25716!$omp target exit data map(release:stored_values)
25717# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25718#endif
25719# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25720 deallocate (stored_values)
25721# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25722#ifdef MFC_DEBUG
25723# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25724 block
25725# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25726 use iso_fortran_env, only: output_unit
25727# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25728
25729# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25730 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(x_coords)'
25731# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25732
25733# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25734 call flush (output_unit)
25735# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25736 end block
25737# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25738#endif
25739# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25740
25741# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25742#if defined(MFC_OpenACC)
25743# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25744!$acc exit data delete(x_coords)
25745# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25746#elif defined(MFC_OpenMP)
25747# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25748!$omp target exit data map(release:x_coords)
25749# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25750#endif
25751# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25752 deallocate (x_coords)
25753# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25754 end if
25755# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25756
25757# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25758 if (allocated(y_coords)) then
25759# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25760#ifdef MFC_DEBUG
25761# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25762 block
25763# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25764 use iso_fortran_env, only: output_unit
25765# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25766
25767# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25768 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(y_coords)'
25769# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25770
25771# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25772 call flush (output_unit)
25773# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25774 end block
25775# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25776#endif
25777# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25778
25779# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25780#if defined(MFC_OpenACC)
25781# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25782!$acc exit data delete(y_coords)
25783# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25784#elif defined(MFC_OpenMP)
25785# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25786!$omp target exit data map(release:y_coords)
25787# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25788#endif
25789# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25790 deallocate (y_coords)
25791# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25792 end if
25793# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25794
25795# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25796 files_loaded = .false.
25797# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25798
25799# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25800 if (allocated(stored_values274)) then
25801# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25802#ifdef MFC_DEBUG
25803# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25804 block
25805# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25806 use iso_fortran_env, only: output_unit
25807# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25808
25809# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25810 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(stored_values274)'
25811# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25812
25813# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25814 call flush (output_unit)
25815# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25816 end block
25817# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25818#endif
25819# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25820
25821# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25822#if defined(MFC_OpenACC)
25823# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25824!$acc exit data delete(stored_values274)
25825# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25826#elif defined(MFC_OpenMP)
25827# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25828!$omp target exit data map(release:stored_values274)
25829# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25830#endif
25831# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25832 deallocate (stored_values274)
25833# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25834 end if
25835# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25836
25837# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25838 files_loaded274 = .false.
25839
25840 end subroutine s_icpp_cuboid
25841
25842 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
25843 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
25844 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
25845 !! allow for the smoothing of its lateral boundary.
25846 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
25847
25848 integer, intent(in) :: patch_id
25849
25850#ifdef MFC_MIXED_PRECISION
25851 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25852#else
25853 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25854#endif
25855 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
25856 integer :: i, j, k !< Generic loop iterators
25857 real(wp) :: radius
25858
25859 integer :: xRows, yRows, nRows, iix, iiy, max_files
25860# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25861 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
25862# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25863 real(wp) :: x_step, y_step
25864# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25865 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
25866# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25867 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
25868# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25869 real(wp) :: delta_x, delta_y
25870# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25871 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
25872# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25873 real(wp), allocatable :: stored_values(:,:,:)
25874# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25875 real(wp), allocatable :: x_coords(:), y_coords(:)
25876# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25877 logical :: files_loaded = .false.
25878# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25879 real(wp) :: domain_xstart
25880# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25881 character(len=20) :: file_num_str !< For storing the file number as a string
25882# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25883 integer :: ios
25884# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25885 integer :: ios2
25886# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25887
25888# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25889 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
25890# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25891 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
25892# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25893 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
25894# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25895 ! y_coords/files_loaded above.
25896# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25897 real(wp), allocatable, dimension(:,:,:) :: stored_values274
25898# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25899 logical :: files_loaded274 = .false.
25900# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25901 integer :: f274, ix274, iy274, unit274, ios274
25902# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25903 integer :: local_ix_beg274, local_iy_beg274
25904# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25905 character(len=300) :: fname274
25906# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25907 character(len=20) :: file_num_str274
25908# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25909 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
25910# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25911 real(wp) :: file_dx274, file_dy274, r_align274
25912 ! Place any declaration of intermediate variables here
25913# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25914 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
25915# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25916 real(wp) :: eps
25917# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25918
25919# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25920 ! IGR Jets Arrays to stor position and radii of jets from input file
25921# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25922 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
25923# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25924 ! Variables to describe initial condition of jet
25925# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25926 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
25927# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25928 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
25929# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25930 real(wp), dimension(0:n,0:p) :: rcut_arr
25931# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25932 integer :: l, q, s !< Iterators for reading input files
25933# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25934 integer :: start, end !< Ints to keep track of position in file
25935# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25936 character(len=100000) :: line ! String to store line in file
25937# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25938 character(len=25) :: value !< String to store value in line
25939# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25940 integer :: NJet !< Number of jets
25941# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25942 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
25943# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25944 logical :: file_exist ! Flag to check if file exists
25945# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25946
25947# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25948 eps = 1e-9_wp
25949# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25950
25951# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25952 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
25953# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25954 eps_smooth = 3._wp
25955# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25956 inquire (file="njet.txt", exist=file_exist)
25957# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25958 if (file_exist) then
25959# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25960 open (unit=10, file="njet.txt", status="old", action="read")
25961# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25962 read (10, *) njet
25963# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25964 close (10)
25965# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25966 else
25967# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25968 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
25969# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25970 end if
25971# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25972
25973# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25974#ifdef MFC_DEBUG
25975# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25976 block
25977# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25978 use iso_fortran_env, only: output_unit
25979# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25980
25981# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25982 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
25983# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25984
25985# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25986 call flush (output_unit)
25987# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25988 end block
25989# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25990#endif
25991# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25992 allocate (y_th_arr(0:njet - 1))
25993# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25994
25995# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25996
25997# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25998#if defined(MFC_OpenACC)
25999# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26000!$acc enter data create(y_th_arr)
26001# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26002#elif defined(MFC_OpenMP)
26003# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26004!$omp target enter data map(always,alloc:y_th_arr)
26005# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26006#endif
26007# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26008#ifdef MFC_DEBUG
26009# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26010 block
26011# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26012 use iso_fortran_env, only: output_unit
26013# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26014
26015# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26016 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
26017# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26018
26019# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26020 call flush (output_unit)
26021# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26022 end block
26023# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26024#endif
26025# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26026 allocate (z_th_arr(0:njet - 1))
26027# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26028
26029# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26030
26031# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26032#if defined(MFC_OpenACC)
26033# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26034!$acc enter data create(z_th_arr)
26035# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26036#elif defined(MFC_OpenMP)
26037# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26038!$omp target enter data map(always,alloc:z_th_arr)
26039# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26040#endif
26041# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26042#ifdef MFC_DEBUG
26043# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26044 block
26045# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26046 use iso_fortran_env, only: output_unit
26047# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26048
26049# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26050 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
26051# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26052
26053# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26054 call flush (output_unit)
26055# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26056 end block
26057# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26058#endif
26059# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26060 allocate (r_th_arr(0:njet - 1))
26061# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26062
26063# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26064
26065# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26066#if defined(MFC_OpenACC)
26067# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26068!$acc enter data create(r_th_arr)
26069# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26070#elif defined(MFC_OpenMP)
26071# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26072!$omp target enter data map(always,alloc:r_th_arr)
26073# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26074#endif
26075# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26076
26077# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26078 inquire (file="jets.csv", exist=file_exist)
26079# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26080 if (file_exist) then
26081# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26082 open (unit=10, file="jets.csv", status="old", action="read")
26083# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26084 do q = 0, njet - 1
26085# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26086 read (10, '(A)') line ! Read a full line as a string
26087# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26088 start = 1
26089# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26090
26091# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26092 do l = 0, 2
26093# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26094 end = index(line(start:), ',') ! Find the next comma
26095# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26096 if (end == 0) then
26097# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26098 value = trim(adjustl(line(start:))) ! Last value in the line
26099# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26100 else
26101# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26102 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
26103# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26104 start = start + end ! Move to next value
26105# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26106 end if
26107# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26108 if (l == 0) then
26109# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26110 read (value, *) y_th_arr(q) ! Convert string to numeric value
26111# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26112 else if (l == 1) then
26113# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26114 read (value, *) z_th_arr(q)
26115# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26116 else
26117# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26118 read (value, *) r_th_arr(q)
26119# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26120 end if
26121# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26122 end do
26123# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26124 end do
26125# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26126 close (10)
26127# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26128
26129# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26130 do q = 0, p
26131# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26132 do l = 0, n
26133# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26134 rcut = 0._wp
26135# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26136 do s = 0, njet - 1
26137# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26138 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
26139# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26140 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
26141# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26142 end do
26143# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26144 rcut_arr(l, q) = rcut
26145# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26146 end do
26147# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26148 end do
26149# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26150 else
26151# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26152 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
26153# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26154 end if
26155# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26156 end if
26157# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26158
26159# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26160 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
26161# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26162#ifdef MFC_DEBUG
26163# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26164 block
26165# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26166 use iso_fortran_env, only: output_unit
26167# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26168
26169# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26170 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
26171# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26172
26173# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26174 call flush (output_unit)
26175# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26176 end block
26177# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26178#endif
26179# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26180 allocate (ih(0:n_glb, 0:p_glb))
26181# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26182
26183# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26184
26185# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26186#if defined(MFC_OpenACC)
26187# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26188!$acc enter data create(ih)
26189# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26190#elif defined(MFC_OpenMP)
26191# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26192!$omp target enter data map(always,alloc:ih)
26193# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26194#endif
26195# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26196
26197# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26198 if (interface_file == '.') then
26199# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26200 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
26201# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26202 else
26203# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26204 inquire (file=trim(interface_file), exist=file_exist)
26205# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26206 if (file_exist) then
26207# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26208 open (unit=10, file=trim(interface_file), status="old", action="read")
26209# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26210 do i = 0, n_glb
26211# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26212 read (10, '(A)') line ! Read a full line as a string
26213# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26214 start = 1
26215# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26216
26217# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26218 do j = 0, p_glb
26219# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26220 end = index(line(start:), ',') ! Find the next comma
26221# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26222 if (end == 0) then
26223# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26224 value = trim(adjustl(line(start:))) ! Last value in the line
26225# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26226 else
26227# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26228 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
26229# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26230 start = start + end ! Move to next value
26231# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26232 end if
26233# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26234 read (value, *) ih(i, j) ! Convert string to numeric value
26235# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26236 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
26237# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26238 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
26239# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26240 end do
26241# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26242 end do
26243# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26244 close (10)
26245# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26246 else
26247# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26248 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
26249# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26250 end if
26251# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26252 end if
26253# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26254 end if
26255# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26256
26257# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26258 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
26259# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26260#ifdef MFC_DEBUG
26261# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26262 block
26263# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26264 use iso_fortran_env, only: output_unit
26265# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26266
26267# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26268 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
26269# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26270
26271# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26272 call flush (output_unit)
26273# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26274 end block
26275# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26276#endif
26277# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26278 allocate (ih(0:n_glb, 0:0))
26279# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26280
26281# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26282
26283# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26284#if defined(MFC_OpenACC)
26285# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26286!$acc enter data create(ih)
26287# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26288#elif defined(MFC_OpenMP)
26289# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26290!$omp target enter data map(always,alloc:ih)
26291# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26292#endif
26293# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26294 if (interface_file == '.') then
26295# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26296 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
26297# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26298 else
26299# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26300 inquire (file=trim(interface_file), exist=file_exist)
26301# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26302 if (file_exist) then
26303# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26304 open (unit=10, file=trim(interface_file), status="old", action="read")
26305# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26306 do i = 0, n_glb
26307# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26308 read (10, '(A)') line ! Read a full line as a string
26309# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26310 value = trim(line)
26311# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26312 read (value, *) ih(i, 0) ! Convert string to numeric value
26313# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26314 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
26315# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26316 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
26317# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26318 end do
26319# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26320 close (10)
26321# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26322 else
26323# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26324 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
26325# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26326 end if
26327# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26328 end if
26329# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26330 end if
26331
26332 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
26333 ! information
26334 x_centroid = patch_icpp(patch_id)%x_centroid
26335 y_centroid = patch_icpp(patch_id)%y_centroid
26336 z_centroid = patch_icpp(patch_id)%z_centroid
26337 length_x = patch_icpp(patch_id)%length_x
26338 length_y = patch_icpp(patch_id)%length_y
26339 length_z = patch_icpp(patch_id)%length_z
26340 radius = patch_icpp(patch_id)%radius
26341 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
26342 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
26343
26344 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
26345 x_boundary%beg = x_centroid - 0.5_wp*length_x
26346 x_boundary%end = x_centroid + 0.5_wp*length_x
26347 y_boundary%beg = y_centroid - 0.5_wp*length_y
26348 y_boundary%end = y_centroid + 0.5_wp*length_y
26349 z_boundary%beg = z_centroid - 0.5_wp*length_z
26350 z_boundary%end = z_centroid + 0.5_wp*length_z
26351
26352 ! Initialize eta=1; modified if smoothing is enabled
26353 eta = 1._wp
26354
26355 ! Assign patch vars if cell is covered and patch has write permission
26356 do k = 0, p
26357 do j = 0, n
26358 do i = 0, m
26359 if (grid_geometry == 3) then
26361 else
26362 cart_y = y_cc(j)
26363 cart_z = z_cc(k)
26364 end if
26365
26366 if (patch_icpp(patch_id)%smoothen) then
26367 if (.not. f_is_default(length_x)) then
26368 eta = tanh(smooth_coeff/min(dy_min, &
26369 & dz_min)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
26370 & + 0.5_wp
26371 else if (.not. f_is_default(length_y)) then
26372 eta = tanh(smooth_coeff/min(dx_min, &
26373 & dz_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
26374 & + 0.5_wp
26375 else
26376 eta = tanh(smooth_coeff/min(dx_min, &
26377 & dy_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
26378 & + 0.5_wp
26379 end if
26380 end if
26381
26382 if (((.not. f_is_default(length_x) .and. f_is_inside_cylinder(cart_y - y_centroid, cart_z - z_centroid, &
26383 & x_cc(i) - x_centroid, radius, &
26384 & length_x)) .or. (.not. f_is_default(length_y) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
26385 & cart_z - z_centroid, cart_y - y_centroid, radius, &
26386 & length_y)) .or. (.not. f_is_default(length_z) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
26387 & cart_y - y_centroid, cart_z - z_centroid, radius, &
26388 & length_z)) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
26389 & k) == smooth_patch_id) then
26390 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
26391
26392
26393 if (patch_icpp(patch_id)%hcid /= dflt_int) then
26394 select case (patch_icpp(patch_id)%hcid)
26395# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26396 case (300) ! Rayleigh-Taylor instability
26397# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26398 rhoh = 3._wp
26399# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26400 rhol = 1._wp
26401# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26402 pref = 1.e5_wp
26403# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26404 pint = pref
26405# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26406 h = 0.7_wp
26407# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26408 lam = 0.2_wp
26409# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26410 wl = 2._wp*pi/lam
26411# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26412 amp = 0.025_wp/wl
26413# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26414
26415# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26416 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
26417# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26418
26419# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26420 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
26421# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26422
26423# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26424 if (alph < eps) alph = eps
26425# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26426 if (alph > 1._wp - eps) alph = 1._wp - eps
26427# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26428
26429# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26430 if (y_cc(j) > inth) then
26431# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26432 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26433# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26434 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26435# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26436 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
26437# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26438 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
26439# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26440 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
26441# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26442 else
26443# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26444 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26445# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26446 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26447# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26448 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
26449# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26450 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
26451# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26452 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
26453# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26454 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
26455# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26456 end if
26457# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26458 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
26459# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26460 h = 0.0_wp
26461# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26462 lam = 1.0_wp
26463# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26464 amp = patch_icpp(patch_id)%a(2)
26465# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26466 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
26467# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26468 if (x_cc(i) > inth) then
26469# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26470 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
26471# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26472 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
26473# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26474 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
26475# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26476 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
26477# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26478 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
26479# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26480 end if
26481# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26482 case (302) ! 3D Jet with IGR
26483# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26484 ux_th = 10*sqrt(1.4*0.4)
26485# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26486 ux_am = 0.0*sqrt(1.4)
26487# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26488 p_th = 2.0_wp
26489# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26490 p_am = 1.0_wp
26491# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26492 rho_th = 1._wp
26493# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26494 rho_am = 1._wp
26495# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26496 y_th = 0.0_wp
26497# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26498 z_th = 0.0_wp
26499# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26500 r_th = 1._wp
26501# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26502 eps_smooth = 1._wp
26503# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26504 eps = 1e-6
26505# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26506
26507# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26508 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
26509# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26510 rcut = f_cut_on(r - r_th, eps_smooth)
26511# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26512 xcut = f_cut_on(x_cc(i), eps_smooth)
26513# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26514
26515# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26516 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
26517# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26518 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
26519# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26520 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
26521# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26522
26523# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26524 if (num_fluids == 1) then
26525# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26526 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
26527# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26528 else
26529# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26530 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
26531# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26532 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
26533# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26534 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))
26535# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26536 end if
26537# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26538
26539# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26540 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
26541# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26542 case (303) ! 3D Multijet
26543# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26544 eps_smooth = 3.0_wp
26545# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26546 ux_th = 10*sqrt(1.4*0.4)
26547# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26548 ux_am = 2.5*sqrt(1.4*0.4)
26549# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26550 p_th = 0.8_wp
26551# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26552 p_am = 0.4_wp
26553# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26554 rho_th = 1._wp
26555# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26556 rho_am = 1._wp
26557# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26558 eps = 1e-6
26559# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26560
26561# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26562 rcut = rcut_arr(j, k)
26563# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26564 xcut = f_cut_on(x_cc(i), eps_smooth)
26565# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26566
26567# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26568 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
26569# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26570 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
26571# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26572 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
26573# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26574
26575# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26576 if (num_fluids == 1) then
26577# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26578 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
26579# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26580 else
26581# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26582 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
26583# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26584 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
26585# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26586 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))
26587# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26588 end if
26589# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26590
26591# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26592 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
26593# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26594 case (304) ! 3D Interface from file cartesian
26595# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26596 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
26597# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26598
26599# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26600 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26601# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26602 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26603# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26604
26605# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26606 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
26607# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26608 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
26609# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26610
26611# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26612 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
26613# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26614 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
26615# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26616
26617# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26618 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
26619# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26620 case (305) ! 3D Interface from file axisymmetric
26621# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26622 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
26623# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26624
26625# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26626 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26627# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26628 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26629# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26630
26631# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26632 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
26633# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26634 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
26635# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26636
26637# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26638 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
26639# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26640 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
26641# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26642
26643# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26644 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
26645# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26646 case (370) ! 3D extrusion of 2D profile from external data
26647# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26648 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
26649# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26650 if (.not. files_loaded) then
26651# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26652 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
26653# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26654 do f = 1, max_files
26655# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26656 write (file_num_str, '(I0)') f
26657# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26658 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
26659# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26660 end do
26661# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26662
26663# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26664 ! Common file reading setup
26665# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26666 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26667# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26668 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
26669# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26670
26671# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26672 select case (num_dims)
26673# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26674 case (1, 2) ! 1D and 2D cases are similar
26675# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26676 ! Count lines
26677# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26678 line_count = 0
26679# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26680 do
26681# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26682 read (unit2, *, iostat=ios2) dummy_x, dummy_y
26683# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26684 if (ios2 /= 0) exit
26685# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26686 line_count = line_count + 1
26687# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26688 end do
26689# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26690 close (unit2)
26691# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26692
26693# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26694 xrows = line_count
26695# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26696 yrows = 1
26697# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26698 index_x = 0
26699# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26700 if (num_dims == 2) index_x = i
26701# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26702#ifdef MFC_DEBUG
26703# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26704 block
26705# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26706 use iso_fortran_env, only: output_unit
26707# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26708
26709# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26710 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
26711# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26712
26713# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26714 call flush (output_unit)
26715# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26716 end block
26717# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26718#endif
26719# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26720 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
26721# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26722
26723# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26724
26725# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26726
26727# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26728#if defined(MFC_OpenACC)
26729# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26730!$acc enter data create(x_coords, stored_values)
26731# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26732#elif defined(MFC_OpenMP)
26733# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26734!$omp target enter data map(always,alloc:x_coords, stored_values)
26735# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26736#endif
26737# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26738
26739# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26740 ! Read data from all files
26741# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26742 do f = 1, max_files
26743# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26744 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26745# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26746 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26747# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26748
26749# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26750 do iter = 1, xrows
26751# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26752 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
26753# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26754 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
26755# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26756 end do
26757# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26758 close (unit)
26759# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26760 end do
26761# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26762
26763# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26764 ! Calculate offsets
26765# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26766 domain_xstart = x_coords(1)
26767# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26768 x_step = x_cc(1) - x_cc(0)
26769# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26770 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
26771# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26772 global_offset_x = nint(abs(delta_x)/x_step)
26773# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26774 case (3) ! 3D case - determine grid structure
26775# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26776 ! Find yRows by counting rows with same x
26777# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26778 read (unit2, *, iostat=ios2) x0, y0, dummy_z
26779# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26780 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
26781# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26782
26783# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26784 yrows = 1
26785# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26786 do
26787# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26788 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26789# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26790 if (ios2 /= 0) exit
26791# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26792 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
26793# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26794 yrows = yrows + 1
26795# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26796 else
26797# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26798 exit
26799# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26800 end if
26801# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26802 end do
26803# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26804 close (unit2)
26805# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26806
26807# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26808 ! Count total rows
26809# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26810 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26811# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26812 nrows = 0
26813# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26814 do
26815# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26816 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26817# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26818 if (ios2 /= 0) exit
26819# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26820 nrows = nrows + 1
26821# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26822 end do
26823# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26824 close (unit2)
26825# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26826
26827# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26828 xrows = nrows/yrows
26829# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26830#ifdef MFC_DEBUG
26831# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26832 block
26833# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26834 use iso_fortran_env, only: output_unit
26835# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26836
26837# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26838 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
26839# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26840
26841# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26842 call flush (output_unit)
26843# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26844 end block
26845# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26846#endif
26847# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26848 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
26849# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26850
26851# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26852
26853# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26854
26855# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26856
26857# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26858#if defined(MFC_OpenACC)
26859# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26860!$acc enter data create(x_coords, y_coords, stored_values)
26861# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26862#elif defined(MFC_OpenMP)
26863# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26864!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
26865# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26866#endif
26867# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26868 index_x = i
26869# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26870 index_y = j
26871# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26872
26873# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26874 ! Read all files
26875# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26876 do f = 1, max_files
26877# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26878 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26879# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26880 if (ios /= 0) then
26881# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26882 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26883# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26884 cycle
26885# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26886 end if
26887# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26888
26889# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26890 iter = 0
26891# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26892 do iix = 1, xrows
26893# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26894 do iiy = 1, yrows
26895# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26896 iter = iter + 1
26897# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26898 if (f == 1) then
26899# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26900 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
26901# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26902 else
26903# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26904 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
26905# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26906 end if
26907# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26908 if (ios /= 0) call s_mpi_abort("Error reading data")
26909# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26910 end do
26911# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26912 end do
26913# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26914 close (unit)
26915# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26916 end do
26917# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26918
26919# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26920 ! Calculate offsets
26921# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26922 x_step = x_cc(1) - x_cc(0)
26923# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26924 y_step = y_cc(1) - y_cc(0)
26925# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26926 delta_x = x_cc(index_x) - x_coords(1)
26927# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26928 delta_y = y_cc(index_y) - y_coords(1)
26929# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26930 global_offset_x = nint(abs(delta_x)/x_step)
26931# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26932 global_offset_y = nint(abs(delta_y)/y_step)
26933# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26934 end select
26935# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26936
26937# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26938 files_loaded = .true.
26939# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26940 end if
26941# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26942
26943# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26944 ! Data assignment
26945# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26946 select case (num_dims)
26947# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26948 case (1)
26949# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26950 idx = i + 1 + global_offset_x
26951# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26952 ! idx must land inside the file's row range: this rank's subdomain offset
26953# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26954 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
26955# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26956 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
26957# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26958 if (idx < 1 .or. idx > xrows) &
26959# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26960 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
26961# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26962 do f = 1, sys_size
26963# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26964 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
26965# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26966 end do
26967# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26968 case (2)
26969# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26970 idx = i + 1 + global_offset_x - index_x
26971# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26972 if (idx < 1 .or. idx > xrows) &
26973# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26974 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
26975# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26976 do f = 1, sys_size - 1
26977# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26978 jump = merge(1, 0, f >= eqn_idx%mom%end)
26979# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26980 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
26981# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26982 end do
26983# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26984 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
26985# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26986 case (3)
26987# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26988 idx = i + 1 + global_offset_x - index_x
26989# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26990 idy = j + 1 + global_offset_y - index_y
26991# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26992 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
26993# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26994 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
26995# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26996 do f = 1, sys_size - 1
26997# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26998 jump = merge(1, 0, f >= eqn_idx%mom%end)
26999# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27000 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
27001# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27002 end do
27003# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27004 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
27005# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27006 end select
27007# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27008 case (380) ! Taylor-Green vortex
27009# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27010 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
27011# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27012 ! geometry 9
27013# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27014 mach = 0.1
27015# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27016 if (patch_id == 1) then
27017# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27018 q_prim_vf(eqn_idx%E)%sf(i, j, &
27019# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27020 & 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)
27021# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27022 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)
27023# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27024 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)
27025# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27026 end if
27027# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27028 case default
27029# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27030 call s_int_to_str(patch_id, istr)
27031# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27032 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
27033# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27034 end select
27035 end if
27036
27037 ! Updating the patch identities bookkeeping variable
27038 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
27039 end if
27040 end do
27041 end do
27042 end do
27043 if (allocated(stored_values)) then
27044# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27045#ifdef MFC_DEBUG
27046# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27047 block
27048# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27049 use iso_fortran_env, only: output_unit
27050# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27051
27052# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27053 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(stored_values)'
27054# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27055
27056# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27057 call flush (output_unit)
27058# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27059 end block
27060# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27061#endif
27062# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27063
27064# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27065#if defined(MFC_OpenACC)
27066# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27067!$acc exit data delete(stored_values)
27068# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27069#elif defined(MFC_OpenMP)
27070# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27071!$omp target exit data map(release:stored_values)
27072# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27073#endif
27074# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27075 deallocate (stored_values)
27076# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27077#ifdef MFC_DEBUG
27078# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27079 block
27080# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27081 use iso_fortran_env, only: output_unit
27082# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27083
27084# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27085 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(x_coords)'
27086# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27087
27088# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27089 call flush (output_unit)
27090# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27091 end block
27092# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27093#endif
27094# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27095
27096# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27097#if defined(MFC_OpenACC)
27098# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27099!$acc exit data delete(x_coords)
27100# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27101#elif defined(MFC_OpenMP)
27102# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27103!$omp target exit data map(release:x_coords)
27104# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27105#endif
27106# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27107 deallocate (x_coords)
27108# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27109 end if
27110# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27111
27112# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27113 if (allocated(y_coords)) then
27114# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27115#ifdef MFC_DEBUG
27116# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27117 block
27118# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27119 use iso_fortran_env, only: output_unit
27120# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27121
27122# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27123 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(y_coords)'
27124# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27125
27126# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27127 call flush (output_unit)
27128# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27129 end block
27130# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27131#endif
27132# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27133
27134# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27135#if defined(MFC_OpenACC)
27136# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27137!$acc exit data delete(y_coords)
27138# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27139#elif defined(MFC_OpenMP)
27140# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27141!$omp target exit data map(release:y_coords)
27142# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27143#endif
27144# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27145 deallocate (y_coords)
27146# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27147 end if
27148# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27149
27150# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27151 files_loaded = .false.
27152# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27153
27154# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27155 if (allocated(stored_values274)) then
27156# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27157#ifdef MFC_DEBUG
27158# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27159 block
27160# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27161 use iso_fortran_env, only: output_unit
27162# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27163
27164# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27165 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(stored_values274)'
27166# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27167
27168# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27169 call flush (output_unit)
27170# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27171 end block
27172# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27173#endif
27174# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27175
27176# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27177#if defined(MFC_OpenACC)
27178# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27179!$acc exit data delete(stored_values274)
27180# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27181#elif defined(MFC_OpenMP)
27182# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27183!$omp target exit data map(release:stored_values274)
27184# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27185#endif
27186# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27187 deallocate (stored_values274)
27188# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27189 end if
27190# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27191
27192# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27193 files_loaded274 = .false.
27194
27195 end subroutine s_icpp_cylinder
27196
27197 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
27198 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
27199 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
27200 !! the smoothing of its boundary.
27201 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
27202
27203 integer, intent(in) :: patch_id
27204
27205#ifdef MFC_MIXED_PRECISION
27206 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
27207#else
27208 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
27209#endif
27210 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
27211 integer :: i, j, k !< Generic loop iterators
27212 real(wp) :: a, b, c, d
27213
27214 integer :: xRows, yRows, nRows, iix, iiy, max_files
27215# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27216 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
27217# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27218 real(wp) :: x_step, y_step
27219# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27220 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
27221# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27222 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
27223# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27224 real(wp) :: delta_x, delta_y
27225# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27226 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
27227# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27228 real(wp), allocatable :: stored_values(:,:,:)
27229# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27230 real(wp), allocatable :: x_coords(:), y_coords(:)
27231# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27232 logical :: files_loaded = .false.
27233# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27234 real(wp) :: domain_xstart
27235# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27236 character(len=20) :: file_num_str !< For storing the file number as a string
27237# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27238 integer :: ios
27239# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27240 integer :: ios2
27241# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27242
27243# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27244 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
27245# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27246 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
27247# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27248 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
27249# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27250 ! y_coords/files_loaded above.
27251# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27252 real(wp), allocatable, dimension(:,:,:) :: stored_values274
27253# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27254 logical :: files_loaded274 = .false.
27255# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27256 integer :: f274, ix274, iy274, unit274, ios274
27257# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27258 integer :: local_ix_beg274, local_iy_beg274
27259# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27260 character(len=300) :: fname274
27261# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27262 character(len=20) :: file_num_str274
27263# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27264 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
27265# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27266 real(wp) :: file_dx274, file_dy274, r_align274
27267 ! Place any declaration of intermediate variables here
27268# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27269 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
27270# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27271 real(wp) :: eps
27272# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27273
27274# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27275 ! IGR Jets Arrays to stor position and radii of jets from input file
27276# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27277 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
27278# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27279 ! Variables to describe initial condition of jet
27280# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27281 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
27282# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27283 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
27284# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27285 real(wp), dimension(0:n,0:p) :: rcut_arr
27286# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27287 integer :: l, q, s !< Iterators for reading input files
27288# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27289 integer :: start, end !< Ints to keep track of position in file
27290# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27291 character(len=100000) :: line ! String to store line in file
27292# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27293 character(len=25) :: value !< String to store value in line
27294# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27295 integer :: NJet !< Number of jets
27296# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27297 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
27298# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27299 logical :: file_exist ! Flag to check if file exists
27300# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27301
27302# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27303 eps = 1e-9_wp
27304# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27305
27306# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27307 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
27308# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27309 eps_smooth = 3._wp
27310# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27311 inquire (file="njet.txt", exist=file_exist)
27312# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27313 if (file_exist) then
27314# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27315 open (unit=10, file="njet.txt", status="old", action="read")
27316# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27317 read (10, *) njet
27318# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27319 close (10)
27320# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27321 else
27322# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27323 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
27324# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27325 end if
27326# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27327
27328# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27329#ifdef MFC_DEBUG
27330# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27331 block
27332# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27333 use iso_fortran_env, only: output_unit
27334# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27335
27336# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27337 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
27338# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27339
27340# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27341 call flush (output_unit)
27342# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27343 end block
27344# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27345#endif
27346# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27347 allocate (y_th_arr(0:njet - 1))
27348# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27349
27350# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27351
27352# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27353#if defined(MFC_OpenACC)
27354# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27355!$acc enter data create(y_th_arr)
27356# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27357#elif defined(MFC_OpenMP)
27358# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27359!$omp target enter data map(always,alloc:y_th_arr)
27360# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27361#endif
27362# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27363#ifdef MFC_DEBUG
27364# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27365 block
27366# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27367 use iso_fortran_env, only: output_unit
27368# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27369
27370# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27371 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
27372# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27373
27374# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27375 call flush (output_unit)
27376# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27377 end block
27378# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27379#endif
27380# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27381 allocate (z_th_arr(0:njet - 1))
27382# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27383
27384# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27385
27386# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27387#if defined(MFC_OpenACC)
27388# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27389!$acc enter data create(z_th_arr)
27390# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27391#elif defined(MFC_OpenMP)
27392# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27393!$omp target enter data map(always,alloc:z_th_arr)
27394# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27395#endif
27396# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27397#ifdef MFC_DEBUG
27398# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27399 block
27400# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27401 use iso_fortran_env, only: output_unit
27402# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27403
27404# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27405 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
27406# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27407
27408# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27409 call flush (output_unit)
27410# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27411 end block
27412# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27413#endif
27414# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27415 allocate (r_th_arr(0:njet - 1))
27416# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27417
27418# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27419
27420# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27421#if defined(MFC_OpenACC)
27422# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27423!$acc enter data create(r_th_arr)
27424# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27425#elif defined(MFC_OpenMP)
27426# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27427!$omp target enter data map(always,alloc:r_th_arr)
27428# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27429#endif
27430# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27431
27432# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27433 inquire (file="jets.csv", exist=file_exist)
27434# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27435 if (file_exist) then
27436# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27437 open (unit=10, file="jets.csv", status="old", action="read")
27438# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27439 do q = 0, njet - 1
27440# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27441 read (10, '(A)') line ! Read a full line as a string
27442# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27443 start = 1
27444# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27445
27446# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27447 do l = 0, 2
27448# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27449 end = index(line(start:), ',') ! Find the next comma
27450# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27451 if (end == 0) then
27452# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27453 value = trim(adjustl(line(start:))) ! Last value in the line
27454# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27455 else
27456# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27457 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
27458# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27459 start = start + end ! Move to next value
27460# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27461 end if
27462# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27463 if (l == 0) then
27464# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27465 read (value, *) y_th_arr(q) ! Convert string to numeric value
27466# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27467 else if (l == 1) then
27468# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27469 read (value, *) z_th_arr(q)
27470# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27471 else
27472# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27473 read (value, *) r_th_arr(q)
27474# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27475 end if
27476# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27477 end do
27478# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27479 end do
27480# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27481 close (10)
27482# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27483
27484# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27485 do q = 0, p
27486# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27487 do l = 0, n
27488# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27489 rcut = 0._wp
27490# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27491 do s = 0, njet - 1
27492# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27493 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
27494# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27495 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
27496# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27497 end do
27498# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27499 rcut_arr(l, q) = rcut
27500# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27501 end do
27502# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27503 end do
27504# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27505 else
27506# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27507 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
27508# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27509 end if
27510# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27511 end if
27512# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27513
27514# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27515 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
27516# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27517#ifdef MFC_DEBUG
27518# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27519 block
27520# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27521 use iso_fortran_env, only: output_unit
27522# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27523
27524# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27525 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
27526# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27527
27528# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27529 call flush (output_unit)
27530# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27531 end block
27532# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27533#endif
27534# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27535 allocate (ih(0:n_glb, 0:p_glb))
27536# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27537
27538# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27539
27540# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27541#if defined(MFC_OpenACC)
27542# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27543!$acc enter data create(ih)
27544# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27545#elif defined(MFC_OpenMP)
27546# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27547!$omp target enter data map(always,alloc:ih)
27548# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27549#endif
27550# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27551
27552# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27553 if (interface_file == '.') then
27554# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27555 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
27556# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27557 else
27558# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27559 inquire (file=trim(interface_file), exist=file_exist)
27560# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27561 if (file_exist) then
27562# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27563 open (unit=10, file=trim(interface_file), status="old", action="read")
27564# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27565 do i = 0, n_glb
27566# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27567 read (10, '(A)') line ! Read a full line as a string
27568# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27569 start = 1
27570# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27571
27572# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27573 do j = 0, p_glb
27574# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27575 end = index(line(start:), ',') ! Find the next comma
27576# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27577 if (end == 0) then
27578# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27579 value = trim(adjustl(line(start:))) ! Last value in the line
27580# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27581 else
27582# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27583 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
27584# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27585 start = start + end ! Move to next value
27586# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27587 end if
27588# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27589 read (value, *) ih(i, j) ! Convert string to numeric value
27590# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27591 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
27592# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27593 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
27594# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27595 end do
27596# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27597 end do
27598# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27599 close (10)
27600# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27601 else
27602# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27603 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
27604# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27605 end if
27606# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27607 end if
27608# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27609 end if
27610# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27611
27612# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27613 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
27614# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27615#ifdef MFC_DEBUG
27616# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27617 block
27618# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27619 use iso_fortran_env, only: output_unit
27620# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27621
27622# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27623 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
27624# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27625
27626# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27627 call flush (output_unit)
27628# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27629 end block
27630# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27631#endif
27632# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27633 allocate (ih(0:n_glb, 0:0))
27634# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27635
27636# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27637
27638# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27639#if defined(MFC_OpenACC)
27640# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27641!$acc enter data create(ih)
27642# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27643#elif defined(MFC_OpenMP)
27644# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27645!$omp target enter data map(always,alloc:ih)
27646# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27647#endif
27648# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27649 if (interface_file == '.') then
27650# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27651 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
27652# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27653 else
27654# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27655 inquire (file=trim(interface_file), exist=file_exist)
27656# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27657 if (file_exist) then
27658# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27659 open (unit=10, file=trim(interface_file), status="old", action="read")
27660# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27661 do i = 0, n_glb
27662# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27663 read (10, '(A)') line ! Read a full line as a string
27664# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27665 value = trim(line)
27666# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27667 read (value, *) ih(i, 0) ! Convert string to numeric value
27668# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27669 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
27670# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27671 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
27672# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27673 end do
27674# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27675 close (10)
27676# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27677 else
27678# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27679 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
27680# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27681 end if
27682# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27683 end if
27684# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27685 end if
27686
27687 ! Transferring the centroid information of the plane to be swept
27688 x_centroid = patch_icpp(patch_id)%x_centroid
27689 y_centroid = patch_icpp(patch_id)%y_centroid
27690 z_centroid = patch_icpp(patch_id)%z_centroid
27691 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
27692 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
27693
27694 ! Obtaining coefficients of the equation describing the sweep plane
27695 a = patch_icpp(patch_id)%normal(1)
27696 b = patch_icpp(patch_id)%normal(2)
27697 c = patch_icpp(patch_id)%normal(3)
27698 d = -a*x_centroid - b*y_centroid - c*z_centroid
27699
27700 ! Initialize eta=1; modified if smoothing is enabled
27701 eta = 1._wp
27702
27703 ! Assign patch vars if cell is covered and patch has write permission
27704 do k = 0, p
27705 do j = 0, n
27706 do i = 0, m
27707 if (grid_geometry == 3) then
27709 else
27710 cart_y = y_cc(j)
27711 cart_z = z_cc(k)
27712 end if
27713
27714 if (patch_icpp(patch_id)%smoothen) then
27715 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx_min, dy_min, &
27716 & dz_min)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
27717 end if
27718
27719 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, &
27720 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
27721 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
27722
27723
27724 if (patch_icpp(patch_id)%hcid /= dflt_int) then
27725 select case (patch_icpp(patch_id)%hcid)
27726# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27727 case (300) ! Rayleigh-Taylor instability
27728# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27729 rhoh = 3._wp
27730# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27731 rhol = 1._wp
27732# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27733 pref = 1.e5_wp
27734# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27735 pint = pref
27736# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27737 h = 0.7_wp
27738# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27739 lam = 0.2_wp
27740# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27741 wl = 2._wp*pi/lam
27742# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27743 amp = 0.025_wp/wl
27744# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27745
27746# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27747 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
27748# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27749
27750# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27751 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
27752# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27753
27754# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27755 if (alph < eps) alph = eps
27756# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27757 if (alph > 1._wp - eps) alph = 1._wp - eps
27758# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27759
27760# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27761 if (y_cc(j) > inth) then
27762# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27763 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27764# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27765 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27766# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27767 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
27768# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27769 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
27770# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27771 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
27772# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27773 else
27774# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27775 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27776# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27777 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27778# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27779 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
27780# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27781 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
27782# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27783 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
27784# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27785 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
27786# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27787 end if
27788# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27789 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
27790# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27791 h = 0.0_wp
27792# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27793 lam = 1.0_wp
27794# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27795 amp = patch_icpp(patch_id)%a(2)
27796# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27797 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
27798# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27799 if (x_cc(i) > inth) then
27800# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27801 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
27802# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27803 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
27804# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27805 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
27806# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27807 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
27808# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27809 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
27810# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27811 end if
27812# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27813 case (302) ! 3D Jet with IGR
27814# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27815 ux_th = 10*sqrt(1.4*0.4)
27816# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27817 ux_am = 0.0*sqrt(1.4)
27818# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27819 p_th = 2.0_wp
27820# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27821 p_am = 1.0_wp
27822# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27823 rho_th = 1._wp
27824# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27825 rho_am = 1._wp
27826# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27827 y_th = 0.0_wp
27828# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27829 z_th = 0.0_wp
27830# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27831 r_th = 1._wp
27832# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27833 eps_smooth = 1._wp
27834# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27835 eps = 1e-6
27836# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27837
27838# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27839 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
27840# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27841 rcut = f_cut_on(r - r_th, eps_smooth)
27842# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27843 xcut = f_cut_on(x_cc(i), eps_smooth)
27844# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27845
27846# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27847 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
27848# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27849 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
27850# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27851 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
27852# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27853
27854# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27855 if (num_fluids == 1) then
27856# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27857 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
27858# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27859 else
27860# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27861 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
27862# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27863 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
27864# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27865 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))
27866# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27867 end if
27868# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27869
27870# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27871 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
27872# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27873 case (303) ! 3D Multijet
27874# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27875 eps_smooth = 3.0_wp
27876# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27877 ux_th = 10*sqrt(1.4*0.4)
27878# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27879 ux_am = 2.5*sqrt(1.4*0.4)
27880# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27881 p_th = 0.8_wp
27882# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27883 p_am = 0.4_wp
27884# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27885 rho_th = 1._wp
27886# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27887 rho_am = 1._wp
27888# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27889 eps = 1e-6
27890# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27891
27892# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27893 rcut = rcut_arr(j, k)
27894# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27895 xcut = f_cut_on(x_cc(i), eps_smooth)
27896# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27897
27898# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27899 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
27900# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27901 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
27902# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27903 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
27904# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27905
27906# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27907 if (num_fluids == 1) then
27908# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27909 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
27910# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27911 else
27912# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27913 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
27914# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27915 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
27916# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27917 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))
27918# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27919 end if
27920# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27921
27922# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27923 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
27924# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27925 case (304) ! 3D Interface from file cartesian
27926# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27927 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))*(0.5_wp/dx_min)))
27928# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27929
27930# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27931 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27932# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27933 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27934# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27935
27936# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27937 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*(950._wp/1000._wp)
27938# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27939 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/1000._wp)
27940# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27941
27942# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27943 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
27944# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27945 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
27946# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27947
27948# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27949 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
27950# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27951 case (305) ! 3D Interface from file axisymmetric
27952# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27953 alph = 0.5_wp*(1 + (1._wp - 2._wp*eps)*tanh((ih(start_idx(2) + j, 0) - x_cc(i))*(0.01_wp/dx_min)))
27954# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27955
27956# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27957 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27958# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27959 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27960# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27961
27962# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27963 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
27964# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27965 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%end)%sf(i, j, k)*(1._wp/950._wp)
27966# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27967
27968# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27969 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p0_ic + (q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, &
27970# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27971 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
27972# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27973
27974# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27975 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
27976# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27977 case (370) ! 3D extrusion of 2D profile from external data
27978# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27979 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
27980# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27981 if (.not. files_loaded) then
27982# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27983 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
27984# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27985 do f = 1, max_files
27986# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27987 write (file_num_str, '(I0)') f
27988# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27989 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
27990# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27991 end do
27992# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27993
27994# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27995 ! Common file reading setup
27996# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27997 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
27998# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27999 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
28000# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28001
28002# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28003 select case (num_dims)
28004# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28005 case (1, 2) ! 1D and 2D cases are similar
28006# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28007 ! Count lines
28008# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28009 line_count = 0
28010# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28011 do
28012# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28013 read (unit2, *, iostat=ios2) dummy_x, dummy_y
28014# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28015 if (ios2 /= 0) exit
28016# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28017 line_count = line_count + 1
28018# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28019 end do
28020# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28021 close (unit2)
28022# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28023
28024# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28025 xrows = line_count
28026# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28027 yrows = 1
28028# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28029 index_x = 0
28030# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28031 if (num_dims == 2) index_x = i
28032# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28033#ifdef MFC_DEBUG
28034# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28035 block
28036# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28037 use iso_fortran_env, only: output_unit
28038# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28039
28040# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28041 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
28042# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28043
28044# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28045 call flush (output_unit)
28046# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28047 end block
28048# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28049#endif
28050# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28051 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
28052# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28053
28054# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28055
28056# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28057
28058# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28059#if defined(MFC_OpenACC)
28060# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28061!$acc enter data create(x_coords, stored_values)
28062# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28063#elif defined(MFC_OpenMP)
28064# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28065!$omp target enter data map(always,alloc:x_coords, stored_values)
28066# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28067#endif
28068# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28069
28070# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28071 ! Read data from all files
28072# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28073 do f = 1, max_files
28074# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28075 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28076# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28077 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28078# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28079
28080# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28081 do iter = 1, xrows
28082# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28083 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
28084# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28085 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
28086# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28087 end do
28088# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28089 close (unit)
28090# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28091 end do
28092# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28093
28094# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28095 ! Calculate offsets
28096# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28097 domain_xstart = x_coords(1)
28098# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28099 x_step = x_cc(1) - x_cc(0)
28100# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28101 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
28102# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28103 global_offset_x = nint(abs(delta_x)/x_step)
28104# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28105 case (3) ! 3D case - determine grid structure
28106# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28107 ! Find yRows by counting rows with same x
28108# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28109 read (unit2, *, iostat=ios2) x0, y0, dummy_z
28110# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28111 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
28112# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28113
28114# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28115 yrows = 1
28116# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28117 do
28118# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28119 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28120# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28121 if (ios2 /= 0) exit
28122# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28123 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
28124# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28125 yrows = yrows + 1
28126# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28127 else
28128# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28129 exit
28130# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28131 end if
28132# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28133 end do
28134# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28135 close (unit2)
28136# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28137
28138# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28139 ! Count total rows
28140# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28141 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
28142# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28143 nrows = 0
28144# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28145 do
28146# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28147 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28148# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28149 if (ios2 /= 0) exit
28150# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28151 nrows = nrows + 1
28152# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28153 end do
28154# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28155 close (unit2)
28156# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28157
28158# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28159 xrows = nrows/yrows
28160# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28161#ifdef MFC_DEBUG
28162# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28163 block
28164# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28165 use iso_fortran_env, only: output_unit
28166# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28167
28168# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28169 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
28170# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28171
28172# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28173 call flush (output_unit)
28174# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28175 end block
28176# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28177#endif
28178# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28179 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
28180# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28181
28182# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28183
28184# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28185
28186# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28187
28188# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28189#if defined(MFC_OpenACC)
28190# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28191!$acc enter data create(x_coords, y_coords, stored_values)
28192# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28193#elif defined(MFC_OpenMP)
28194# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28195!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
28196# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28197#endif
28198# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28199 index_x = i
28200# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28201 index_y = j
28202# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28203
28204# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28205 ! Read all files
28206# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28207 do f = 1, max_files
28208# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28209 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28210# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28211 if (ios /= 0) then
28212# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28213 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28214# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28215 cycle
28216# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28217 end if
28218# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28219
28220# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28221 iter = 0
28222# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28223 do iix = 1, xrows
28224# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28225 do iiy = 1, yrows
28226# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28227 iter = iter + 1
28228# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28229 if (f == 1) then
28230# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28231 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
28232# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28233 else
28234# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28235 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
28236# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28237 end if
28238# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28239 if (ios /= 0) call s_mpi_abort("Error reading data")
28240# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28241 end do
28242# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28243 end do
28244# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28245 close (unit)
28246# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28247 end do
28248# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28249
28250# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28251 ! Calculate offsets
28252# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28253 x_step = x_cc(1) - x_cc(0)
28254# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28255 y_step = y_cc(1) - y_cc(0)
28256# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28257 delta_x = x_cc(index_x) - x_coords(1)
28258# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28259 delta_y = y_cc(index_y) - y_coords(1)
28260# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28261 global_offset_x = nint(abs(delta_x)/x_step)
28262# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28263 global_offset_y = nint(abs(delta_y)/y_step)
28264# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28265 end select
28266# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28267
28268# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28269 files_loaded = .true.
28270# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28271 end if
28272# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28273
28274# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28275 ! Data assignment
28276# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28277 select case (num_dims)
28278# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28279 case (1)
28280# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28281 idx = i + 1 + global_offset_x
28282# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28283 ! idx must land inside the file's row range: this rank's subdomain offset
28284# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28285 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
28286# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28287 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
28288# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28289 if (idx < 1 .or. idx > xrows) &
28290# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28291 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28292# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28293 do f = 1, sys_size
28294# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28295 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
28296# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28297 end do
28298# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28299 case (2)
28300# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28301 idx = i + 1 + global_offset_x - index_x
28302# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28303 if (idx < 1 .or. idx > xrows) &
28304# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28305 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28306# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28307 do f = 1, sys_size - 1
28308# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28309 jump = merge(1, 0, f >= eqn_idx%mom%end)
28310# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28311 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
28312# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28313 end do
28314# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28315 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
28316# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28317 case (3)
28318# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28319 idx = i + 1 + global_offset_x - index_x
28320# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28321 idy = j + 1 + global_offset_y - index_y
28322# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28323 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
28324# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28325 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
28326# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28327 do f = 1, sys_size - 1
28328# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28329 jump = merge(1, 0, f >= eqn_idx%mom%end)
28330# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28331 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
28332# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28333 end do
28334# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28335 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
28336# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28337 end select
28338# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28339 case (380) ! Taylor-Green vortex
28340# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28341 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
28342# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28343 ! geometry 9
28344# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28345 mach = 0.1
28346# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28347 if (patch_id == 1) then
28348# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28349 q_prim_vf(eqn_idx%E)%sf(i, j, &
28350# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28351 & 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)
28352# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28353 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)
28354# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28355 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)
28356# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28357 end if
28358# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28359 case default
28360# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28361 call s_int_to_str(patch_id, istr)
28362# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28363 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
28364# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28365 end select
28366 end if
28367
28368 ! Updating the patch identities bookkeeping variable
28369 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
28370 end if
28371 end do
28372 end do
28373 end do
28374 if (allocated(stored_values)) then
28375# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28376#ifdef MFC_DEBUG
28377# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28378 block
28379# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28380 use iso_fortran_env, only: output_unit
28381# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28382
28383# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28384 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(stored_values)'
28385# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28386
28387# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28388 call flush (output_unit)
28389# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28390 end block
28391# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28392#endif
28393# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28394
28395# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28396#if defined(MFC_OpenACC)
28397# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28398!$acc exit data delete(stored_values)
28399# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28400#elif defined(MFC_OpenMP)
28401# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28402!$omp target exit data map(release:stored_values)
28403# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28404#endif
28405# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28406 deallocate (stored_values)
28407# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28408#ifdef MFC_DEBUG
28409# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28410 block
28411# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28412 use iso_fortran_env, only: output_unit
28413# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28414
28415# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28416 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(x_coords)'
28417# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28418
28419# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28420 call flush (output_unit)
28421# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28422 end block
28423# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28424#endif
28425# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28426
28427# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28428#if defined(MFC_OpenACC)
28429# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28430!$acc exit data delete(x_coords)
28431# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28432#elif defined(MFC_OpenMP)
28433# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28434!$omp target exit data map(release:x_coords)
28435# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28436#endif
28437# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28438 deallocate (x_coords)
28439# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28440 end if
28441# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28442
28443# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28444 if (allocated(y_coords)) then
28445# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28446#ifdef MFC_DEBUG
28447# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28448 block
28449# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28450 use iso_fortran_env, only: output_unit
28451# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28452
28453# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28454 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(y_coords)'
28455# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28456
28457# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28458 call flush (output_unit)
28459# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28460 end block
28461# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28462#endif
28463# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28464
28465# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28466#if defined(MFC_OpenACC)
28467# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28468!$acc exit data delete(y_coords)
28469# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28470#elif defined(MFC_OpenMP)
28471# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28472!$omp target exit data map(release:y_coords)
28473# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28474#endif
28475# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28476 deallocate (y_coords)
28477# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28478 end if
28479# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28480
28481# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28482 files_loaded = .false.
28483# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28484
28485# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28486 if (allocated(stored_values274)) then
28487# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28488#ifdef MFC_DEBUG
28489# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28490 block
28491# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28492 use iso_fortran_env, only: output_unit
28493# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28494
28495# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28496 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(stored_values274)'
28497# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28498
28499# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28500 call flush (output_unit)
28501# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28502 end block
28503# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28504#endif
28505# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28506
28507# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28508#if defined(MFC_OpenACC)
28509# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28510!$acc exit data delete(stored_values274)
28511# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28512#elif defined(MFC_OpenMP)
28513# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28514!$omp target exit data map(release:stored_values274)
28515# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28516#endif
28517# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28518 deallocate (stored_values274)
28519# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28520 end if
28521# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28522
28523# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28524 files_loaded274 = .false.
28525
28526 end subroutine s_icpp_sweep_plane
28527
28528 !> The STL patch is a 2/3D geometry that is imported from an STL file.
28529 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
28530
28531 integer, intent(in) :: patch_id
28532
28533#ifdef MFC_MIXED_PRECISION
28534 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
28535#else
28536 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
28537#endif
28538 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
28539 integer :: i, j, k !< loop iterators
28540 integer :: model_id !< Index into the preloading stl_models(:)
28541 real(wp) :: threshold !< Inside/outside cutoff for this model
28542 real(wp), dimension(1:3) :: point !< Cell-center query point
28543 logical :: in_box !< Whether the cell center lies in the model's bounding box
28544
28545 model_id = patch_icpp(patch_id)%model_id
28546 threshold = stl_models(model_id)%model_threshold
28547
28548 do i = 0, m; do j = 0, n; do k = 0, p
28549 point = (/x_cc(i), y_cc(j), 0._wp/)
28550 if (p > 0) point(3) = z_cc(k)
28551 if (grid_geometry == 3) point = f_convert_cyl_to_cart(point)
28552
28553 ! Run the winding test only on cells whose Cartesian point lies inside the bounding box, else skip the calculation
28554 in_box = point(1) >= stl_bounding_boxes(model_id, 1, 1) .and. point(1) <= stl_bounding_boxes(model_id, 1, &
28555 & 3) .and. point(2) >= stl_bounding_boxes(model_id, 2, &
28556 & 1) .and. point(2) <= stl_bounding_boxes(model_id, 2, 3)
28557 if (p > 0 .or. grid_geometry == 3) then
28558 in_box = in_box .and. point(3) >= stl_bounding_boxes(model_id, 3, &
28559 & 1) .and. point(3) <= stl_bounding_boxes(model_id, 3, 3)
28560 end if
28561
28562 if (in_box) then
28563 eta = f_model_is_inside(gpu_ntrs(model_id), model_id, point)
28564 else
28565 eta = 0._wp
28566 end if
28567
28568 if (eta > threshold) then
28569 eta = 1._wp
28570 else if (.not. patch_icpp(patch_id)%smoothen) then
28571 eta = 0._wp
28572 end if
28573
28574 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
28575
28576
28577 end do; end do; end do
28578
28579 end subroutine s_icpp_model
28580
28581 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
28583
28584
28585# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28586#if MFC_OpenACC
28587# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28588!$acc routine seq
28589# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28590#elif MFC_OpenMP
28591# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28592
28593# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28594
28595# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28596!$omp declare target device_type(any)
28597# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28598#endif
28599
28600 real(wp), intent(in) :: cyl_y, cyl_z
28601
28602 cart_y = cyl_y*sin(cyl_z)
28603 cart_z = cyl_y*cos(cyl_z)
28604
28606
28607 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
28608 function f_convert_cyl_to_cart(cyl) result(cart)
28609
28610
28611# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28612#if MFC_OpenACC
28613# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28614!$acc routine seq
28615# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28616#elif MFC_OpenMP
28617# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28618
28619# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28620
28621# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28622!$omp declare target device_type(any)
28623# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28624#endif
28625
28626 real(wp), dimension(1:3), intent(in) :: cyl
28627 real(wp), dimension(1:3) :: cart
28628
28629 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
28630
28631 end function f_convert_cyl_to_cart
28632
28633 !> Archimedes spiral function
28634 elemental function f_r(myth, offset, a)
28635
28636
28637# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28638#if MFC_OpenACC
28639# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28640!$acc routine seq
28641# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28642#elif MFC_OpenMP
28643# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28644
28645# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28646
28647# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28648!$omp declare target device_type(any)
28649# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28650#endif
28651 real(wp), intent(in) :: myth, offset, a
28652 real(wp) :: b
28653 real(wp) :: f_r
28654
28655 ! r(th) = a + b*th
28656
28657 b = 2._wp*a/(2._wp*pi)
28658 f_r = a + b*myth + offset
28659
28660 end function f_r
28661
28662end module m_icpp_patches
integer, intent(in) k
integer, intent(in) j
integer, intent(in) l
Assigns initial primitive variables to computational cells based on patch geometry.
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Pointer to mixture or species patch assignment routine.
Compile-time constant parameters: default values, tolerances, and physical constants.
real(wp), parameter small_radius
Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14).
integer, parameter dflt_int
Default integer value.
integer, parameter max_2d_fourier_modes
Max Fourier mode index for 2D modal patch (geometry 13).
integer, parameter max_sph_harm_degree
Max degree L for 3D spherical harmonic patch (geometry 14).
real(wp), parameter pi
Pi.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
integer proc_rank
Rank of the local processor Number of cells in the x-, y- and z-coordinate directions.
real(wp), dimension(:), allocatable x_cc
Locations of cell-centers (cc) in x-, y- and z-directions, respectively.
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Allocate memory and read initial condition data for IC extrusion.
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...
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.
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....
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...
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,...
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.
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...
character(len=5) istr
string to store int to string result for error checking
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,...
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,...
impure subroutine, public s_apply_icpp_patches(patch_id_fp, q_prim_vf)
Dispatch each initial condition patch to its geometry-specific initialization routine.
real(wp) smooth_coeff
Smoothing coefficient (mirrors ic_patch_parameterssmooth_coeff).
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....
type(bounds_info) y_boundary
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...
real(wp) eta
Pseudo volume fraction for patch boundary smoothing.
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.
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,...
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.
subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
type(bounds_info) x_boundary
type(bounds_info) z_boundary
Patch boundary locations in x, y, z.
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,...
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...
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...
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...
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.
Binary STL file reader and processor for immersed boundary geometry.
subroutine, public s_instantiate_stl_models()
Load, transform, and register STL/OBJ immersed-boundary models onto the simulation grid.
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
Contains helper functions specific to various patch gemoetries for determining if a grid cell lies in...
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Derived type adding beginning (beg) and end bounds info as attributes.
Derived type annexing a scalar field (SF).